Kurt Kuzba BRESENHAM LINE/CIRCLE ALGORITHMFidoNet QUIK_BAS Echo 04-16-96 (00:00) QB, QBasic, PDS 73 2314 BRESNHAM.BAS'_|_|_| BRESNHAM.BASπ'_|_|_| This program demonstrates the Bresenham Algorithmsπ'_|_|_| for the drawing of lines and circles, using PSET.π'_|_|_| Adapted from BRESNHAM.C in Bob Stout's SNIPPETS.π'_|_|_| No warrantee or guarantee is implied or given.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (4/16/96)πDECLARE SUB BLine (x%, y%, x2%, y2%, c%)πDECLARE SUB BCircle (x%, y%, r%, c%)πSCREEN 13πHIGH% = 200 'The Bresenham Cirlce will need to know the screenπWIDE% = 320 'dimensions, which are found in these SHARED variablesπndx% = 0πRANDOMIZE (TIMER * 100 + INP(64))πDIM xy(412) AS LONGπBCircle 159, 99, 65, 77πDEF SEG = &HA000πFOR t& = 0 TO 63999π IF PEEK(t&) = 77 THEN xy(ndx%) = t&: ndx% = ndx% + 1πNEXT:πWHILE INKEY$ = ""π BCircle 159, 99, RND * 129 + 70, RND * 255π ndx% = (RND * 400 + 5)π l1& = xy(ndx%)π x1% = l1& MOD 320π y1% = l1& \ 320π l2& = xy(ndx% + 3)π x2% = l2& MOD 320π y2% = l2& \ 320π BLine x1%, y1%, x2%, y2%, RND * 255πWENDπSOUND 999, 1πWHILE INKEY$ = "": WENDπSCREEN 0πWIDTH 80, 25πENDπSUB BCircle (xc%, yc%, r%, c%)π'_|_|_| Bresenham Circle Drawing Algorithmπ'_|_|_| Adapted from BRESNHAM.C in Bob Stout's SNIPPETS.π SHARED WIDE%, HIGH%π x% = 0: d% = 2 * (1 - r%): W% = 2 * WIDE% \ HIGH%π WHILE r% >= 0π PSET (xc% + x%, yc% + r%), c%π PSET (xc% + x%, yc% - r%), c%π PSET (xc% - x%, yc% + r%), c%π PSET (xc% - x%, yc% - r%), c%π IF (d% + r%) > 0 THEN r% = r% - 1: d% = d% - W% * r% - 1π IF x% > d% THEN x% = x% + 1: d% = d% + 2 * x% + 1π WENDπEND SUBπSUB BLine (x%, y%, x2%, y2%, c%)π'_|_|_| Bresenham Line Drawing Algorithmπ'_|_|_| Adapted from BRESNHAM.C in Bob Stout's SNIPPETS.π i% = 0: steep% = 0: e% = 0π IF (x2% - x%) > 0 THEN sx% = 1: ELSE sx% = -1π dx% = ABS(x2% - x%)π IF (y2% - y%) > 0 THEN sy% = 1: ELSE sy% = -1π dy% = ABS(y2% - y%)π IF (dy% > dx%) THENπ steep% = 1π SWAP x%, y%π SWAP dx%, dy%π SWAP sx%, sy%π END IFπ e% = 2 * dy% - dx%π FOR i% = 0 TO dx% - 1π IF steep% = 1 THEN PSET (y%, x%), c%: ELSE PSET (x%, y%), c%π WHILE e% >= 0π y% = y% + sy%: e% = e% - 2 * dx%π WENDπ x% = x% + sx%: e% = e% + 2 * dy%π NEXTπ PSET (x2%, y2%), c%πEND SUBπTyler Barnes BASE CONVERSION ROUTINE Tyler.Barnes@access.cn.camriv.b07-28-96 (12:32) QB, QBasic, PDS 47 1659 BASE.BAS 'A lot of the code in this sub is extraneous, and is only put there to speed things up.ππ'If you don't know how to use this, just email me at Tyler.Barnes@access.cn.camriv.bc.caππDECLARE SUB Base2Base (Number1$, Digits1$, Number2$, Digits2$)πCONST Bin = "01", Oct = "01234567", Dec = "0123456789", Hex = "0123456789ABCDEF"ππDEFLNG A-ZπSUB Base2Base (Number1$, Digits1$, Number2$, Digits2$)πNumber1$ = UCASE$(Number1$): Digits1$ = UCASE$(Digits1$)πDigits2$ = UCASE$(Digits2$)πIF Digits1$ <> "0123456789" THENπFOR I% = LEN(Number1$) TO 1 STEP -1πIF Digits1$ = "01234567" THEN FinalNum = VAL("&O" + Number1$): I% = 1πIF Digits1$ = "0123456789ABCDEF" THEN FinalNum = VAL("&H" + Number1$): I% = 1πCD$ = MID$(Number1$, I%, 1)πCV% = INSTR(Digits1$, CD$) - 1πFinalNum = FinalNum + (CV% * (LEN(Digits1$) ^ ABS(I% - LEN(Number1$))))πNEXT I%πELSEπFinalNum = VAL(Number1$)πEND IFπIF Digits2$ = "0123456789" THEN Number2$ = LTRIM$(STR$(FinalNum)): EXIT SUBπIF Digits2$ = "0123456789ABCDEF" THEN Number2$ = HEX$(FinalNum): EXIT SUBπIF Digits2$ = "01234567" THEN Number2$ = OCT$(FinalNum): EXIT SUBπNumber2$ = "": NeverDone% = 1πLD2% = LEN(Digits2$)πDOπFOR I% = 1 TO LD2%πIT& = (I% - 1) * (LD2% ^ DPos%)πIF IT& > FinalNum THEN Z% = 1: I% = I% - 1πIF IT& = FinalNum OR Z% = 1 THENπIF Z% = 1 THENπIF I% = 1 THEN I% = LD2%: DPos% = DPos% - 1πEND IFπIF NeverDone% = 1 THEN NeverDone% = 0: N2$ = STRING$(DPos% + 1, "0")πMID$(N2$, LEN(N2$) - DPos%, 1) = MID$(Digits2$, I%, 1)πFinalNum = FinalNum - ((I% - 1) * (LD2% ^ DPos%))πDPos% = -1πZ% = 0πEXIT FORπEND IFπNEXT I%πDPos% = DPos% + 1πLOOP UNTIL FinalNum = 0πNumber2$ = N2$πEND SUBπM. Rosenberg PB HUFFMAN ENCODER QBTIPS_T.DOC 12-03-93 (15:30) PB 133 4759 HUFFMAN.BAS 'Hey all, well I a recently got a Hufman algrorithm for BASIC. Sadly itπ'was made only for PowerBasic and I use QuickBasic. Could some of youπ'guys out there with both QB/PB experience possibly modify the code ??ππCLSπInFile$="A SIMPLE STRING TO BE ENCODED USING A MINIMAL NUMBER OF BITS"ππCALL Huffman(InFile$,OutFile$,NewFile$)πprint:print:printπPRINT "In: ";LEN(InFile$);InFile$πPRINT "Out: ";LEN(OutFile$)πPRINT "New: ";LEN(NewFile$);NewFile$πinput,rππENDπ'**********************************************************************π' Huffman Encoding File Compression Techniqueπ'π' From: R Sedgwick. Algorithms. Reading, MA: Addison-Wesley.π' 1984. Second Ed. pp 286 / 93.π'π' Converted to Power Basic by M. Rosenberg CI$: [73707,2545]π'πSUB Huffman(InText$,OutText$,NewText$)π SHARED N%,Heap%(),Count%()π DIM Count%(1024),Heap%(1024),Dad%(1024),Code%(256),Leng%(256)ππ' Count the frequency of each character in the message to be encoded (P. 287)π FOR I%=0 to 255 : Count%(I%)=0 : NEXT I%π Csr%=0π DO : INCR Csr% : X%=ASC(MID$(InText$,Csr%,1)) : INCR Count%(X%)π LOOP UNTIL Csr%=LEN(InText$)ππ' Initialize the heap array to point to non-zero frequency counts (P. 290)ππ N%=0 : FOR I%=0 to 255 : IF Count%(I%)<>0 THEN INCR N% : Heap%(N%)=I%π NEXT I%π' Construct an indirect heap on the frequency values (P. 289)ππ FOR K% = N% TO 1 STEP -1 : CALL PqDownHeap(K%) : NEXT K%ππ' Construct the trie (P. 290)π DO : T%=Heap%(1) : Heap%(1)=Heap%(N%) : DECR N%π CALL PqDownHeap(1)π Count%(255+N%)=Count%(Heap%(1))+Count%(T%)π Dad%(T%)=255+N% : Dad%(Heap%(1))=-255-N%π Heap%(1)=255+N% : CALL PqDownHeap(1)π LOOP UNTIL N%=1π Dad%(255+N%)=0ππ' Reconstruct the information from the representation of the coding tree (P.291)π' computed during the sifting process.ππ FOR K% = 0 TO 255π IF Count%(K%)=0 THENπ Code%(K%)=0 : Leng%(K%)=0π ELSEπ I%=0 : J&=1 : T%=Dad%(K%) : X%=0π DO : IF T%<0 THEN X%=X%+J& : T%=0-T%π T%=Dad%(T%) : J&=J&+J& : INCR I%π LOOP UNTIL T%=0π Code%(K%)=X% : Leng%(K%)=I%π END IFπ NEXT K%π' Use the computed representations of the code to encode the string (P. 292)ππ J%=0 : OutText$="" : Hold$=""π DO : INCR J%π Char%=ASC(MID$(InText$,J%,1)) : Compr$=BIN$(Code%(Char%))π DO WHILE LEN(Compr$)< Leng%(Char%) : Compr$="0"+Compr$ : LOOPπ Hold$=Hold$+Compr$π IF LEN(Hold$)>8 THENπ π OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8))) Hold$=RIGHT$(Hold$,LEN(Hold$)-8)π END IFπ LOOP UNTIL J%=LEN(InText$)ππ' Add a byte at the end that contains any left-over bitsππ IF LEN(Hold$)>0 THENπ Hold$=Hold$+STRING$(8-LEN(Hold$),"0")π OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8)))π END IFπ'**********************************************************************π' Unpack compressed string into character representation of binaryππ J%=0 : UnCompr$="" : NewText$=""π DO : INCR J%π Hold$=MID$(OutText$,J%,1) : Hold$=BIN$(ASC(Hold$))π DO WHILE LEN(Hold$)<8 : Hold$="0"+Hold$ : LOOPπ UnCompr$=UnCompr$+Hold$π LOOP UNTIL J%=LEN(OutText$)ππ' Decode compressed stringππ DO : FOR K%=1 TO 256π IF K%=256 THEN EXIT LOOP 'All doneπ IF Leng%(K%)>0 THENπ IF Bin2Int(LEFT$(UnCompr$,Leng%(K%)))=Code%(K%) THENπ π UnCompr$=RIGHT$(UnCompr$,LEN(UnCompr$)-Leng%(K%))π NewText$=NewText$+CHR$(K%) : EXIT FORπ END IFπ END IFπ NEXT K%π LOOP UNTIL LEN(UnCompr$) = 0πππEND SUB 'HuffmanππSUB PqDownHeap(K%)π' Build and maintain an indirect heap on the frequency values (P. 139)π' reversing the inequalities since we want the smallest values first.ππ SHARED N%,Heap%(),Count%()π LOCAL J%,V%,Limit%π V%=Heap%(K%) : Limit% = N%/2π DO WHILE K% <= Limit%π J%=K%+K%π IF J%<N% THEN IF Count%(Heap%(J%)) > Count%(Heap%(J%+1)) THEN INCR J%π IF Count%(V%)<=Count%(Heap%(J%)) THEN Heap%(K%)=V% : EXIT SUBπ Heap%(K%)=Heap%(J%) : Heap%(J%)=V% : K%=J%π LOOPπEND SUB 'PqDownHeapππ'**********************************************************************πFUNCTION Bin2Int(X$)πX$=RTRIM$(X$) :X$=LTRIM$(X$) : Ll%=LEN(X$) : Ex%=0 : Tot%=0 : I%=Ll%π DO WHILE I% > 0π IF MID$(X$,I%,1)="1" THEN Tot&=Tot&+(2^Ex&)π INCR Ex& : DECR I% : WENDπ Bin2Int=Tot&πEND FUNCTION 'Bin2IntπFranklin Villamor NUMBER OF POSSIBLE COMBINATIONSartvil@ix.netcom.com 08-25-96 (22:38) QB, QBasic, PDS 17 545 COMBINAT.BASTo find out how many possibilities there can be:ππclsπinput "Number of different states for each object: ", aπinput "Number of objects: ", bππfor x = 0 to b - 1πc = c + a^xπnext xππprint "Number of possibilities: ", cππImagine a row of four sheets of paper. Each paper can be in one of twoπstates, either the blank side, or the written on side. The variable "a" isπthe number of states (in this case 2). The variable "b" is the number ofπobjects (in this case 4). This will have 15 different unique combinationsπ(which is "c").πStuart McLachlan ENVIRONMENT PATHNAME comp.lang.basic.misc 07-11-96 (16:56) ASIC 32 791 PATH.ASI Rem Get Program Segment Prefix Addressπ Ax=&Hex6200π Int86(&Hex21,Ax,Bx,Na,Na,Na,Na,Na,Na,Na)π Defseg = BxππRem Get Address Of Environment Blockπ Lo = Peek(&Hex2c)π Hi = Peek(&Hex2d)π Env = Hi * 256π Env = Env + Loπ Defseg = EnvππRem Get Environment Lengthπ For Environment = 0 To 511π Temp=Peek(Environment)π If Temp = 1 Thenπ Locationstart = Environment + 2π Environment = 511π Endifπ Next EnvironmentππRem Get File Location Dataπ For Filelocation = Locationstart To 511π Temp = Peek(Filelocation)π If Temp <> 0 Thenπ Nextstring$ = Chr$(Temp)π Fileloc$ = Fileloc$ + Nextstring$π Elseπ Filelocation = 511π Endifπ Next FilelocationπPrint Fileloc$πDaniel Garlans DEBUG ASM CONVERTER garlans@usa.pipeline.com 07-29-96 (17:10) QB, QBasic, PDS 116 6028 DEBUGASM.BAS'DEBUG ASM Converter Version 1.0a Rewrite 1 π'Written by: White Shade of DuoTech π'(Real Name: Daniel Garlans) π'This program is freeware. π'You may use this code any way you like, just give me credit =] π'Information on conversion from a FAQ by Ian Muskgrave (sorry if I misspelled) π'My E-Mail Address: garlans@usa.pipeline.com π'This converts DEBUG-ASM (debug < name.dbg > out.asm) into CALL ABSOLUTE strings π'and saves them and code for use into an out file. π'This is rewrite 1 because my first version was written at about 9:30 to 10:30 pm π'and I was tired and so it was huge, messy and wasn't working, so the next day π'I wrote it entirely from scratch :) π'Absolutly needed in the file to convert from: π'-U in a line to show where the HEX Code output started and -Q in a line toππ'show what line the output ends on. Format of a converted line in result file: π'ASM$=ASM$+whatevertoadd 'offset = xxxx:xxxx hex code:whateverthehexis π'the ASM$ can be changed to whatever. π'Sub Cp prints t$ in the center of row l! in 80 column text mode. π'Have fun with this :) It's fully commented. π'you can do whatever you want with it... π'THINGS 2 KNOW: No error handling...Still some optimizing to do...quite fast... π'can convert something like a 16k file (I don't have anything that big to test with) π πDECLARE SUB Cp (t$, l!) πCLS π'print a headline :) πCOLOR 15, 1 'set background to dark blue, foreground to bright white πLOCATE 1, 1: PRINT STRING$(80, " ") 'make first line be all dark blue πCALL Cp("DebugASM Converter 1.0a", 1) 'use Cp to write the text to the center πCOLOR 7, 0 'make colors normal πINPUT "File to Convert:"; a$: file$ = UCASE$(a$) 'get filename and make it uppercase πINPUT "File to write to:"; a$: outfile$ = UCASE$(a$)'get output name and make it uppercase πINPUT "String to write to:"; a$: cnme$ = UCASE$(a$)'get string name in output file and make it uppercase πPRINT " Converting: " + file$ 'display info πPRINT " Saving output to: " + outfile$ 'ditto πPRINT " Converted Code String: " + cnme$ 'ditto πOPEN file$ FOR INPUT AS #1 'Open Files πOPEN outfile$ FOR OUTPUT AS #2 'Open Files πst = 0 'start pos... if still 0 after next block, error :) πen = 0'end pos...ditto πPRINT "Finding start of hex code values"; πDO WHILE NOT EOF(1) 'Loop until end of the file π LINE INPUT #1, a$ 'get a line (commas etc allowed) π c$ = UCASE$(a$) 'convert to uppercase π IF INSTR(c$, "-U") THEN 'Is -U in it? (indicates start of hex code) π st = v + 1 'If it is, make the start equal the next line in file π END IF π IF INSTR(c$, "-Q") THEN 'Is -Q in it? (indicates end of hex code) π en = v 'If so, make end equal this line π END IF π PRINT "."; 'Display a dot to show that the proggy is working :) π v = v + 1 'Increase current-line counter πLOOP 'duh :) πPRINT 'go to next line (because of the 'print ".";') πSEEK 1, 1 'Set current position in input file to first character (it was at the end) π'DIM lne$(1 TO v) 'Actually, This isn't needed...wonder what I was thinking.... :) πIF st = 0 OR en = 0 THEN 'Wait! If the start and end positions are STILL zero now, the program failed. π PRINT "Error, -U or -Q not found. Unable to convert." π CLOSE 'close files π END 'duhh :) πEND IF π πPRINT "Moving to start of HEX code at line "; st πFOR a = 1 TO st 'loop until start line π LINE INPUT #1, temp$ 'so the file pos is moved. πNEXT a πlnt = en - st 'amount of lines between -U and -Q πPRINT "Converting & Saving..." πFOR a = 1 TO lnt 'loop for the lines between -U and -Q π LINE INPUT #1, a$ 'get the line to work on π a$ = UCASE$(a$) 'make uppercase (for neatness in output) π IF LEN(a$) > 0 THEN 'so it doesn't try to convert a blank line :) π offse$ = LEFT$(a$, 9) 'Get Offset (always first 9 letters xxxx:xxxx) π toconv$ = MID$(a$, 11, 6) 'get the HEX Code to convert π toconv$ = RTRIM$(toconv$) 'trim spaces from end π toconv$ = LTRIM$(toconv$) ' " " " start π 'dn = LEN(tonconv$) 'get length...whoops this isn't needed because... π SELECT CASE LEN(toconv$) 'select case with the length of this :) π CASE 2 'maybe like CB (retf) π fin$ = "CHR$(&H" + toconv$ + ")" 'Make the output string.. π CASE 4 'maybe like CD33 (int 33h) π one$ = LEFT$(toconv$, 2) 'get first two letters π two$ = RIGHT$(toconv$, 2) 'get last two letters π fin$ = "chr$(&H" + one$ + ") + chr$(&H" + two$ + ")" 'make output string π CASE 6 'maybe like B80100 (mov ax,0001) π one$ = LEFT$(toconv$, 2) 'get first two π two$ = MID$(toconv$, 3, 2) 'get last two π fin$ = "chr$(&H" + one$ + ") + chr$(&H" + two$ + ")" 'make output string π CASE ELSE 'Prolly an error π PRINT "Warning: Unknown hex string, cannot convert." π fin$ = "" 'make output string be nothing. π END SELECT π IF LEN(fin$) <> 0 THEN 'do this only if the output string is more than nothing (see in CASE ELSE it sets FIN$ to nothing?) π v$ = cnme$ + "=" + cnme$ + "+" + fin$ + " 'Offset=" + offse$ + " Hex Command= " + toconv$ 'Assemble output string (see opening comments) π PRINT #2, v$ 'write final final output string to the output file π END IF π END IF πNEXT a πPRINT "Writing info for code use..." π'next four lines write commented out code for the use of the converted code. πPRINT #2, "'These next commented lines are for using the converted code." πPRINT #2, "'DEF SEG=VARSEG(" + cnme$ + ")" πPRINT #2, "'theoff%=SADD(" + cnme$ + ")" πPRINT #2, "'CALL ABSOLUTE(theoff%)" πCLOSE 'close all file handles πPRINT "Conversion of Debug-Asm complete."' " + file$ + " to " + outfile$ + " in " + cnme$ 'give a little info πPRINT "Coding by: White Shade of DuoTech" 'More info πPRINT "This program is Freeware and may be freely distributed." 'and a little more.. πEND 'Terminate program :) π πSUB Cp (t$, l) π v = 40 - (LEN(t$) / 2) π LOCATE l, v π PRINT t$ πEND SUB πPaul Kuliniewicz ENIGMA CODING PROGRAM home.aol.com/Borg953 07-10-96 (00:00) QB, QBasic, PDS 761 26994 ECP.BAS ' ***************************************************************************π' *** Enigma Coding Program ***π' ***************************************************************************π' written by Paul Kuliniewiczπ' version 1.0π' WARNING! ANY TAMPERING WITH THIS FILE MAY CAUSE IT TO MALFUNCTION ANDπ' DAMAGE ANY FILES YOU WORK WITH! THE AUTHOR IS NOT RESPONSIBLE FOR DAMAGEπ' CAUSED BY EDITING THIS FILE!π' This file is Public Domain. You may distribute this file as you wishπ' freely, as long as the file has not been altered in any way.π' Notice to Windows Users: only run this file in FULL SCREEN! (this fileπ' writes and reads directly to and from screen memory. Running in a windowπ' may cause unexpected, and possibly dangerous, results)π' *** Prepare for Operation Routine ***πDECLARE SUB CenterText (text$)πDECLARE SUB Shadow (urr%, urc%, llr%, llc%, lrr%, lrc%)πDECLARE SUB LoadImage (showme%())πDECLARE SUB SaveImage (saveme%())πDECLARE SUB StatusLine (message$, sector$)πDECLARE FUNCTION MessWithByte$ (original$)πDECLARE FUNCTION PseudoNOT$ (bit$)πDECLARE FUNCTION MakeBinary$ (convert%)πDECLARE FUNCTION MakeDecimal% (byte$)πDECLARE FUNCTION ConvBlock% (row%, column%, colormem%)πDECLARE FUNCTION ConvColor% (fore%, back%)πDECLARE FUNCTION Character$ ()πCLEARπON ERROR GOTO HandleErrorπKEY OFFπCLSπ'$STATICπDIM mainimage%(0 TO 4001)πDIM screenimage%(0 TO 4001)πDIM mainstatus$(1 TO 6)πDIM helpstatus$(1 TO 6)πFOR counter% = 1 TO 6π READ mainstatus$(counter%)πNEXT counter%πFOR counter% = 1 TO 6π READ helpstatus$(counter%)πNEXT counter%πCONST TRUE = -1πCONST FALSE = 0πfirsttime% = FALSEπDEF SEG = &HB800π' *** Title Screen Display Routine ***πFOR counter% = ConvBlock%(1, 1, 1) TO ConvBlock%(24, 80, 1) STEP 2π POKE counter%, ConvColor%(7, 1)πNEXT counter%πFOR counter% = ConvBlock%(25, 1, 1) TO ConvBlock%(25, 80, 1) STEP 2π POKE counter%, ConvColor%(4, 7)πNEXT counter%πCOLOR 7, 1πLOCATE 4, 1πCenterText "EEEEEE CCCC PPPPP "πCenterText "EEEEEE CCCCCC PPPPPP"πCenterText "EE CC CC PP PP"πCenterText "EE CC PP PP"πCenterText "EEEEE CC PPPPPP"πCenterText "EEEEE CC PPPPP "πCenterText "EE CC PP "πCenterText "EE CC CC PP "πCenterText "EEEEEE CCCCCC PP "πCenterText "EEEEEE CCCC PP "πPRINTπPRINTπCenterText "Enigma Coding Program v1.0"πPRINTπCenterText "1995 Paul Kuliniewicz"πStatusLine "Welcome to the Enigma Coding Program! Press any key to continue.", "WELCOME"πSLEEP: trash$ = INKEY$πGOTO MainMenuπ' *** Main Menu Routine ***πMainMenu:πIF firsttime% = FALSE THENπ LOCATE 1, 1π COLOR 4, 7π PRINT "┌─────MAIN MENU─────┐"π PRINT "│ 1. Code a file │"π PRINT "│ 2. Decode a file │"π PRINT "│ 3. Kill a file │"π PRINT "│ 4. Shell to DOS │"π PRINT "│ 5. Help │"π PRINT "│ 6. Leave ECP │"π PRINT "└───────────────────┘"π Shadow 2, 22, 9, 2, 9, 22π SaveImage mainimage%()π firsttime% = TRUEπELSEπ LoadImage mainimage%()πEND IFπmin% = 2πmax% = 7πoldarrow% = 2πnewarrow% = 2πchoice% = 1πentered% = FALSEπDOπ POKE ConvBlock%(oldarrow%, 3, 0), ASC(" ")π POKE ConvBlock%(newarrow%, 3, 0), ASC("»")π StatusLine mainstatus$(choice%), "MENU"π pressed$ = Character$π oldarrow% = newarrow%π IF LEN(pressed$) = 2 AND RIGHT$(pressed$, 1) = CHR$(72) THENπ IF choice% = 1 THENπ newarrow% = max%π choice% = 6π ELSEπ newarrow% = newarrow% - 1π choice% = choice% - 1π END IFπ ELSEIF LEN(pressed$) = 2 AND RIGHT$(pressed$, 1) = CHR$(80) THENπ IF choice% = 6 THENπ newarrow% = min%π choice% = 1π ELSEπ newarrow% = newarrow% + 1π choice% = choice% + 1π END IFπ ELSEIF pressed$ = CHR$(13) THENπ entered% = TRUEπ END IFπLOOP UNTIL entered% = TRUEπON choice% GOTO Code, Decode, Delete, DOS, Help, Quitπ' *** Coding Routine ***πCode:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌──────────────────────────CODE──────────────────────────┐"πLOCATE 4, 3: PRINT "│ Enter the file (and path, if needed) you wish to code. │"πLOCATE 5, 3: PRINT "│ > │"πLOCATE 6, 3: PRINT "└────────────────────────────────────────────────────────┘"πShadow 4, 61, 7, 4, 7, 61πSaveImage screenimage%()πStatusLine "Type in the file name to code.", "CODE"πLOCATE 5, 6πLINE INPUT "", filename$πLOCATE 5, 5: PRINT "┌────────────CODE────────────┐"πLOCATE 6, 5: PRINT "│ Coding file. Please wait. │"πLOCATE 7, 5: PRINT "└────────────────────────────┘"πShadow 6, 35, 8, 6, 8, 35πTinker:πStatusLine "Please wait. Accessing Disk.", "CODE"πinfo$ = SPACE$(10000)πOPEN filename$ FOR BINARY AS #1πIF LOF(1) = 0 THENπ CLOSE #1π KILL filename$π ERROR 53πEND IFπtrash$ = MessWithByte$("NEW")πlength& = LOF(1)πFOR counter& = 1 TO length& - (length& MOD 10000) STEP 10000π GET #1, counter&, info$π FOR count% = 1 TO LEN(info$)π MID$(info$, count%, 1) = MessWithByte$(MID$(info$, count%, 1))π NEXT count%π PUT #1, counter&, info$πNEXT counter&πinfo$ = SPACE$(length& MOD 10000)πGET #1, (length& - (length& MOD 10000)) + 1, info$πFOR count% = 1 TO LEN(info$)π MID$(info$, count%, 1) = MessWithByte$(MID$(info$, count%, 1))πNEXT count%πPUT #1, (length& - (length& MOD 10000)) + 1, info$πCLOSE #1πIF choice% = 2 THEN GOTO AllDoneπLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌───────CODE───────┐"πLOCATE 6, 5: PRINT "│ Coding finished. │"πLOCATE 7, 5: PRINT "└──────────────────┘"πShadow 6, 25, 8, 6, 8, 25πStatusLine "Press any key to continue.", "CODE"πSLEEP: trash$ = INKEY$πGOTO MainMenuπ' *** Decoding Routine ***πDecode:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌──────────────────────────DECODE──────────────────────────┐"πLOCATE 4, 3: PRINT "│ Enter the file (and path, if needed) you wish to decode. │"πLOCATE 5, 3: PRINT "│ > │"πLOCATE 6, 3: PRINT "└──────────────────────────────────────────────────────────┘"πShadow 4, 63, 7, 4, 7, 63πSaveImage screenimage%()πStatusLine "Type in the file name to decode.", "DECODE"πLOCATE 5, 6πLINE INPUT "", filename$πLOCATE 5, 5: PRINT "┌────────────DECODE────────────┐"πLOCATE 6, 5: PRINT "│ Decoding file. Please wait. │"πLOCATE 7, 5: PRINT "└──────────────────────────────┘"πShadow 6, 37, 8, 6, 8, 37πStatusLine "Please wait. Accessing disk.", "DECODE"πGOTO Tinkerπinfo$ = SPACE$(10000)πOPEN filename$ FOR BINARY AS #1πIF LOF(1) = 0 THENπ CLOSE #1π KILL filename$π ERROR 53πEND IFπtrash$ = MessWithByte$("NEW")πlength& = LOF(1)πFOR counter& = 1 TO length% - (length& MOD 10000) STEP 10000π GET #1, counter&, info$π FOR count% = 1 TO LEN(info$)π MID$(info$, count%, 1) = MessWithByte$(MID$(info$, count%, 1))π NEXT count%π PUT #1, counter&, info$πNEXT counter&πinfo$ = SPACE$(length& MOD 10000)πGET #1, (length& - (length& MOD 10000)) + 1, info$πFOR count% = 1 TO LEN(info$)π MID$(info$, count%, 1) = MessWithByte$(MID$(info$, count%, 1))πNEXT count%πPUT #1, (length& - (length& MOD 10000)) + 1, info$πCLOSE #1πAllDone:πLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌───────DECODE───────┐"πLOCATE 6, 5: PRINT "│ Decoding finished. │"πLOCATE 7, 5: PRINT "└────────────────────┘"πShadow 6, 27, 8, 6, 8, 27πStatusLine "Press any key to continue.", "DECODE"πSLEEP: trash$ = INKEY$πGOTO MainMenuπ' *** Killing Routine ***πDelete:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌──────────────────────────KILL──────────────────────────┐"πLOCATE 4, 3: PRINT "│ Enter the file (and path, if needed) you wish to kill. │"πLOCATE 5, 3: PRINT "│ > │"πLOCATE 6, 3: PRINT "└────────────────────────────────────────────────────────┘"πShadow 4, 61, 7, 4, 7, 61πSaveImage screenimage%()πStatusLine "Type in the file to kill.", "KILL"πLOCATE 5, 6πLINE INPUT "", filename$πLOCATE 5, 5: PRINT "┌──────────────────────────DANGER───────────────────────────┐"πLOCATE 6, 5: PRINT "│ KILLING A FILE WILL TOTALLY DESTROY IT BEYOND ALL HOPE OF │"πLOCATE 7, 5: PRINT "│ REPAIR! NOT EVEN AN UNDELETE PROGRAM CAN SAVE IT! ARE │"πLOCATE 8, 5: PRINT "│ YOU SURE YOU WANT TO DO THIS? (Y/N) │"πLOCATE 9, 5: PRINT "└───────────────────────────────────────────────────────────┘"πShadow 6, 66, 10, 6, 10, 66πStatusLine "Press Y for YES or N for NO.", "KILL"πDOπ rusure$ = UCASE$(Character$)πLOOP UNTIL rusure$ = "Y" OR rusure$ = "N"πIF rusure$ = "N" THEN GOTO MainMenuπLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌──────────────────────WARNING──────────────────────┐"πLOCATE 6, 5: PRINT "│ THERE IS NO WAY TO RECOVER THIS FILE IF YOU KILL │"πLOCATE 7, 5: PRINT "│ IT. ARE YOU ABSOLUTELY SURE YOU WANT TO DO THIS? │"πLOCATE 8, 5: PRINT "└───────────────────────────────────────────────────┘"πShadow 6, 58, 9, 6, 9, 58πStatusLine "Press Y for YES or N for NO.", "KILL"πDOπ rusure$ = UCASE$(Character$)πLOOP UNTIL rusure$ = "Y" OR rusure$ = "N"πIF rusure$ = "N" THEN GOTO MainMenuπLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌────────────KILL─────────────┐"πLOCATE 6, 5: PRINT "│ Killing file. Please wait. │"πLOCATE 7, 5: PRINT "└─────────────────────────────┘"πShadow 6, 36, 8, 6, 8, 36πStatusLine "Please wait. Accessing disk.", "KILL"πinfo$ = STRING$(10000, 0)πOPEN filename$ FOR BINARY AS #1πIF LOF(1) = 0 THENπ CLOSE #1π KILL filename$π ERROR 53πEND IFπlength& = LOF(1)πFOR counter& = 1 TO length& - (length% MOD 10000) STEP 10000π PUT #1, counter&, info$πNEXT counter&πinfo$ = SPACE$(length& MOD 10000)πPUT #1, (length& - (length& MOD 10000)) + 1, info$πCLOSE #1πKILL filename$πLoadImage screenimage%()πLOCATE 5, 5: PRINT "┌───────KILL────────┐"πLOCATE 6, 5: PRINT "│ Killing finished. │"πLOCATE 7, 5: PRINT "└───────────────────┘"πShadow 6, 26, 8, 6, 8, 26πStatusLine "Press any key to continue.", "KILL"πSLEEP: trash$ = INKEY$πGOTO MainMenuπ' *** DOS Shell Routine ***πDOS:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌─────────────────SHELL────────────────┐"πLOCATE 4, 3: PRINT "│ Initiating DOS Shell. Type EXIT to │"πLOCATE 5, 3: PRINT "│ return to the Enigma Coding Program. │"πLOCATE 6, 3: PRINT "└──────────────────────────────────────┘"πShadow 4, 43, 7, 4, 7, 43πStatusLine "Press any key to shell to DOS.", "SHELL"πSLEEP: trash$ = INKEY$πCOLOR 7, 0πCLSπSHELLπCOLOR 4, 7πGOTO MainMenuπ' *** Help Routine ***πHelp:πLoadImage mainimage%()πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌─────HELP MENU─────┐"πLOCATE 4, 3: PRINT "│ 1. Overview │"πLOCATE 5, 3: PRINT "│ 2. Coding files │"πLOCATE 6, 3: PRINT "│ 3. Killing files │"πLOCATE 7, 3: PRINT "│ 4. Shell to DOS │"πLOCATE 8, 3: PRINT "│ 5. Disclaimer │"πLOCATE 9, 3: PRINT "│ 6. Exit Help │"πLOCATE 10, 3: PRINT "└───────────────────┘"πShadow 4, 24, 11, 4, 11, 24πmin% = 4πmax% = 9πoldarrow% = 4πnewarrow% = 4πhelped% = 1πentered% = FALSEπDOπ POKE ConvBlock%(oldarrow%, 5, 0), ASC(" ")π POKE ConvBlock%(newarrow%, 5, 0), ASC("»")π StatusLine helpstatus$(helped%), "HELP"π pressed$ = Character$π oldarrow% = newarrow%π IF LEN(pressed$) = 2 AND RIGHT$(pressed$, 1) = CHR$(72) THENπ IF helped% = 1 THENπ newarrow% = max%π helped% = 6π ELSEπ newarrow% = newarrow% - 1π helped% = helped% - 1π END IFπ ELSEIF LEN(pressed$) = 2 AND RIGHT$(pressed$, 1) = CHR$(80) THENπ IF helped% = 6 THENπ newarrow% = min%π helped% = 1π ELSEπ newarrow% = newarrow% + 1π helped% = helped% + 1π END IFπ ELSEIF pressed$ = CHR$(13) THENπ entered% = TRUEπ END IFπLOOP UNTIL entered% = TRUEπSELECT CASE helped%πCASE 1π LOCATE 5, 5: PRINT "┌─────────────────────────OVERVIEW─────────────────────────┐"π LOCATE 6, 5: PRINT "│ The Enigma Coding Program is a useful file safety device │"π LOCATE 7, 5: PRINT "│ for coding, decoding, and killing files. This program │"π LOCATE 8, 5: PRINT "│ can code files in a way that only it can decode. Also, │"π LOCATE 9, 5: PRINT "│ to completely destroy files, you can kill them. All │"π LOCATE 10, 5: PRINT "│ this comes with an easy-to-use, window-based interface. │"π LOCATE 11, 5: PRINT "│ The other options in the Help Menu will give you details │"π LOCATE 12, 5: PRINT "│ about these particular operations. Please read the dis- │"π LOCATE 13, 5: PRINT "│ claimer before using this program. │"π LOCATE 14, 5: PRINT "└──────────────────────────────────────────────────────────┘"π Shadow 6, 65, 15, 6, 15, 65πCASE 2π LOCATE 5, 5: PRINT "┌──────────────────────────CODING──────────────────────────┐"π LOCATE 6, 5: PRINT "│ The Enigma Coding Program can code files so other people │"π LOCATE 7, 5: PRINT "│ can't use them. This process works with any file, whe- │"π LOCATE 8, 5: PRINT "│ ther it's an *.EXE, *.BAT, *.WMF, *.INI, etc. To code a │"π LOCATE 9, 5: PRINT "│ file, choose Code a File from the Main Menu and follow │"π LOCATE 10, 5: PRINT "│ the simple instructions. To decode a file, choose De- │"π LOCATE 11, 5: PRINT "│ code a File from the Main Menu and follow the similar │"π LOCATE 12, 5: PRINT "│ instructions. │"π LOCATE 13, 5: PRINT "└──────────────────────────────────────────────────────────┘"π Shadow 6, 65, 14, 6, 14, 65πCASE 3π LOCATE 5, 5: PRINT "┌─────────────────────────KILLING──────────────────────────┐"π LOCATE 6, 5: PRINT "│ The Enigma Coding Program can wipe out files. This is │"π LOCATE 7, 5: PRINT "│ not the same as erasing! When you kill a file, all the │"π LOCATE 8, 5: PRINT "│ bytes in the file are assigned the null (0) value before │"π LOCATE 9, 5: PRINT "│ being deleted. Even an undelete program will only bring │"π LOCATE 10, 5: PRINT "│ back a bunch of null characters. To kill a file, choose │"π LOCATE 11, 5: PRINT "│ Kill a File from the Main Menu and follow the simple │"π LOCATE 12, 5: PRINT "│ instructions. │"π LOCATE 13, 5: PRINT "└──────────────────────────────────────────────────────────┘"π Shadow 6, 65, 14, 6, 14, 65πCASE 4π LOCATE 5, 5: PRINT "┌─────────────────────────SHELLING─────────────────────────┐"π LOCATE 6, 5: PRINT "│ The Enigma Coding Program allows you to temporarily use │"π LOCATE 7, 5: PRINT "│ DOS while the program is running. While in the shell, │"π LOCATE 8, 5: PRINT "│ you can execute any commands you normally can. When you │"π LOCATE 9, 5: PRINT "│ are finished, type EXIT to end the shell. To execute │"π LOCATE 10, 5: PRINT "│ the shell, choose Shell to DOS from the Main Menu. │"π LOCATE 11, 5: PRINT "└──────────────────────────────────────────────────────────┘"π Shadow 6, 65, 12, 6, 12, 65πCASE 5π LOCATE 5, 5: PRINT "┌────────────────────────DISCLAIMER────────────────────────┐"π LOCATE 6, 5: PRINT "│ DO NOT TAMPER WITH OR EDIT THIS FILE IN ANY WAY! DOING │"π LOCATE 7, 5: PRINT "│ SO MAY CAUSE THIS PROGRAM TO MALFUNCTION AND DAMAGE ANY │"π LOCATE 8, 5: PRINT "│ AND ALL FILES YOU WORK WITH! THE AUTHOR IS NOT RESPON- │"π LOCATE 9, 5: PRINT "│ SIBLE FOR ANY DAMAGE DUE TO ANY EDITING! YOU ARE FREE │"π LOCATE 10, 5: PRINT "│ TO COPY AND DISTRIBUTE THIS PROGRAM TO ANYONE YOU WISH, │"π LOCATE 11, 5: PRINT "│ AS LONG AS THE FILE IS UNALTERED IN ANY CONCEIVABLE WAY! │"π LOCATE 12, 5: PRINT "└──────────────────────────────────────────────────────────┘"π Shadow 6, 65, 13, 6, 13, 65πEND SELECTπIF helped% = 6 THEN GOTO MainMenuπStatusLine "Press any key to return to the Help Menu.", "HELP"πSLEEP: trash$ = INKEY$πGOTO Helpπ' *** Exit Program Routine ***πQuit:πCOLOR 4, 7πLOCATE 3, 3: PRINT "┌───────BYE────────┐"πLOCATE 4, 3: PRINT "│ Have a nice day! │"πLOCATE 5, 3: PRINT "└──────────────────┘"πShadow 4, 23, 6, 4, 6, 23πStatusLine "Press any key to exit ECP.", "BYE"πSLEEP: trash$ = INKEY$πSYSTEMπ' *** Error Handler Routine ***πHandleError:πCOLOR 4, 7πRESETπSELECT CASE ERRπCASE 52π RESUME MainMenuπCASE 53π LOCATE 7, 7: PRINT "┌────────────────ERROR────────────────┐"π LOCATE 8, 7: PRINT "│ That file could not be found on the │"π LOCATE 9, 7: PRINT "│ indicated drive and directory. │"π LOCATE 10, 7: PRINT "└─────────────────────────────────────┘"π Shadow 8, 46, 11, 8, 11, 46πCASE 61π LOCATE 7, 7: PRINT "┌─────────────────────ERROR─────────────────────┐"π LOCATE 8, 7: PRINT "│ There is not enough free space on that drive. │"π LOCATE 9, 7: PRINT "└───────────────────────────────────────────────┘"π Shadow 8, 56, 10, 8, 10, 56πCASE 64π LOCATE 7, 7: PRINT "┌──────────────────────ERROR──────────────────────┐"π LOCATE 8, 7: PRINT "│ That file name contains invalid DOS characters. │"π LOCATE 9, 7: PRINT "└─────────────────────────────────────────────────┘"π Shadow 8, 58, 10, 8, 10, 58πCASE 70π LOCATE 7, 7: PRINT "┌─────────────ERROR─────────────┐"π LOCATE 8, 7: PRINT "│ That disk is write-protected. │"π LOCATE 9, 7: PRINT "└───────────────────────────────┘"π Shadow 8, 40, 10, 8, 10, 40πCASE 71π LOCATE 7, 7: PRINT "┌────────────────────────ERROR────────────────────────┐"π LOCATE 8, 7: PRINT "│ That disk drive is open or there is no disk inside. │"π LOCATE 9, 7: PRINT "└─────────────────────────────────────────────────────┘"π Shadow 8, 62, 10, 8, 10, 62πCASE 72π LOCATE 7, 7: PRINT "┌───────────────────ERROR───────────────────┐"π LOCATE 8, 7: PRINT "│ That disk's surface is physically flawed. │"π LOCATE 9, 7: PRINT "└───────────────────────────────────────────┘"π Shadow 8, 52, 10, 8, 10, 52πCASE 75π LOCATE 7, 7: PRINT "┌──────────────────ERROR──────────────────┐"π LOCATE 8, 7: PRINT "│ You can't code, decode, or kill a path. │"π LOCATE 9, 7: PRINT "└─────────────────────────────────────────┘"π Shadow 8, 50, 10, 8, 10, 50πCASE 76π LOCATE 7, 7: PRINT "┌──────────────────ERROR──────────────────┐"π LOCATE 8, 7: PRINT "│ That path can't be found on this drive. │"π LOCATE 9, 7: PRINT "└─────────────────────────────────────────┘"π Shadow 8, 50, 10, 8, 10, 50πCASE ELSEπ LOCATE 7, 7: PRINT "┌────────────────────────ERROR─────────────────────────┐"π LOCATE 8, 7: PRINT "│ Unidentified error";π PRINT USING " ### "; ERR;π PRINT "reported! Please contact the │"π LOCATE 9, 7: PRINT "│ author via e-mail at Borg953@aol.com. Unfortunatly, │"π LOCATE 10, 7: PRINT "│ ECP cannot recover. │"π LOCATE 11, 7: PRINT "└──────────────────────────────────────────────────────┘"π Shadow 8, 63, 12, 8, 12, 63π StatusLine "Press any key to abort ECP.", "ERROR"π SLEEP: trash$ = INKEY$π SYSTEMπEND SELECTπStatusLine "Press any key to return.", "ERROR"πSLEEP: trash$ = INKEY$πIF choice% >= 1 AND choice% <= 3 THEN LoadImage screenimage%()πSELECT CASE choice%πCASE 1π RESUME CodeπCASE 2π RESUME DecodeπCASE 3π RESUME DeleteπCASE ELSEπ RESUME MainMenuπEND SELECTπ' *** Data for Main Menu Status Line ***πDATA "Code a file with the ECP technique."πDATA "Decode a file coded with the ECP technique."πDATA "Totally destroy a file."πDATA "Use DOS without exiting ECP."πDATA "Additional help with ECP."πDATA "Returns you to your operating system."π' *** Data for Help Menu Status Line ***πDATA "Read the overview of ECP."πDATA "Read about coding and decoding files."πDATA "Read about killing files."πDATA "Read about the DOS Shell."πDATA "Read very important warnings."πDATA "Return to the Main Menu."π' *** End of file "ECP.BAS" ***ππSUB CenterText (text$)π blanks% = INT((80 - LEN(text$)) / 2)π PRINT TAB(blanks%); text$πEND SUBππFUNCTION Character$π DOπ justpushed$ = INKEY$π LOOP UNTIL justpushed$ <> CHR$(0)π Character$ = justpushed$πEND FUNCTIONππFUNCTION ConvBlock% (row%, column%, colormem%)π ConvBlock% = (((column% * 2) - 2) + ((row% * 160) - 160)) + colormem%πEND FUNCTIONππFUNCTION ConvColor% (fore%, back%)π ConvColor% = fore% + (back% * 16)πEND FUNCTIONππSUB LoadImage (showme%())π FOR counter% = 0 TO 4001π POKE counter%, showme%(counter%)π NEXT counter%πEND SUBππFUNCTION MakeBinary$ (convert%)π equiv$ = HEX$(convert%)π IF convert% <= 15 THEN equiv$ = "0" + equiv$π FOR counter% = 1 TO LEN(equiv$)π onepart$ = MID$(equiv$, counter%, 1)π IF onepart$ = "0" THENπ result$ = result$ + "0000"π ELSEIF onepart$ = "1" THENπ result$ = result$ + "0001"π ELSEIF onepart$ = "2" THENπ result$ = result$ + "0010"π ELSEIF onepart$ = "3" THENπ result$ = result$ + "0011"π ELSEIF onepart$ = "4" THENπ result$ = result$ + "0100"π ELSEIF onepart$ = "5" THENπ result$ = result$ + "0101"π ELSEIF onepart$ = "6" THENπ result$ = result$ + "0110"π ELSEIF onepart$ = "7" THENπ result$ = result$ + "0111"π ELSEIF onepart$ = "8" THENπ result$ = result$ + "1000"π ELSEIF onepart$ = "9" THENπ result$ = result$ + "1001"π ELSEIF onepart$ = "A" THENπ result$ = result$ + "1010"π ELSEIF onepart$ = "B" THENπ result$ = result$ + "1011"π ELSEIF onepart$ = "C" THENπ result$ = result$ + "1100"π ELSEIF onepart$ = "D" THENπ result$ = result$ + "1101"π ELSEIF onepart$ = "E" THENπ result$ = result$ + "1110"π ELSEIF onepart$ = "F" THENπ result$ = result$ + "1111"π END IFπ NEXT counter%π MakeBinary$ = result$πEND FUNCTIONππFUNCTION MakeDecimal% (byte$)π result% = 0π IF LEFT$(byte$, 1) = "1" THEN result% = result% + 128π IF MID$(byte$, 2, 1) = "1" THEN result% = result% + 64π IF MID$(byte$, 3, 1) = "1" THEN result% = result% + 32π IF MID$(byte$, 4, 1) = "1" THEN result% = result% + 16π IF MID$(byte$, 5, 1) = "1" THEN result% = result% + 8π IF MID$(byte$, 6, 1) = "1" THEN result% = result% + 4π IF MID$(byte$, 7, 1) = "1" THEN result% = result% + 2π IF RIGHT$(byte$, 1) = "1" THEN result% = result% + 1π MakeDecimal% = result%πEND FUNCTIONππFUNCTION MessWithByte$ (original$)π STATIC style%π IF original$ = "NEW" THENπ style% = 0π EXIT FUNCTIONπ END IFπ style% = style% + 1π IF style% > 20 THEN style% = 1π decimal% = ASC(original$)π base2$ = MakeBinary$(decimal%)π bit1$ = LEFT$(base2$, 1)π bit2$ = MID$(base2$, 2, 1)π bit3$ = MID$(base2$, 3, 1)π bit4$ = MID$(base2$, 4, 1)π bit5$ = MID$(base2$, 5, 1)π bit6$ = MID$(base2$, 6, 1)π bit7$ = MID$(base2$, 7, 1)π bit8$ = RIGHT$(base2$, 1)π SELECT CASE style%π CASE 1π bit1$ = PseudoNOT$(bit1$)π bit4$ = PseudoNOT$(bit4$)π bit6$ = PseudoNOT$(bit6$)π bit7$ = PseudoNOT$(bit7$)π CASE 2π bit2$ = PseudoNOT$(bit2$)π bit3$ = PseudoNOT$(bit3$)π bit5$ = PseudoNOT$(bit5$)π bit8$ = PseudoNOT$(bit8$)π CASE 3π SWAP bit1$, bit2$π SWAP bit3$, bit4$π SWAP bit5$, bit6$π SWAP bit7$, bit8$π CASE 4π SWAP bit1$, bit8$π SWAP bit2$, bit7$π SWAP bit4$, bit5$π CASE 5π bit1$ = PseudoNOT$(bit1$)π bit2$ = PseudoNOT$(bit2$)π bit3$ = PseudoNOT$(bit3$)π bit4$ = PseudoNOT$(bit4$)π SWAP bit5$, bit8$π SWAP bit6$, bit7$π CASE 6π CASE 7π bit1$ = PseudoNOT$(bit1$)π SWAP bit2$, bit3$π bit4$ = PseudoNOT$(bit4$)π bit5$ = PseudoNOT$(bit5$)π SWAP bit6$, bit7$π bit8$ = PseudoNOT$(bit8$)π CASE 8π SWAP bit1$, bit3$π SWAP bit2$, bit4$π CASE 9π bit1$ = PseudoNOT$(bit1$)π bit2$ = PseudoNOT$(bit2$)π bit3$ = PseudoNOT$(bit3$)π bit4$ = PseudoNOT$(bit4$)π bit5$ = PseudoNOT$(bit5$)π bit6$ = PseudoNOT$(bit6$)π bit7$ = PseudoNOT$(bit7$)π bit8$ = PseudoNOT$(bit8$)π CASE 10π SWAP bit1$, bit5$π SWAP bit2$, bit6$π SWAP bit3$, bit7$π SWAP bit4$, bit8$π CASE 11π bit1$ = PseudoNOT$(bit1$)π SWAP bit2$, bit3$π bit4$ = PseudoNOT$(bit4$)π bit5$ = PseudoNOT$(bit5$)π SWAP bit6$, bit8$π bit7$ = PseudoNOT$(bit7$)π CASE 12π SWAP bit1$, bit3$π SWAP bit2$, bit6$π bit4$ = PseudoNOT$(bit4$)π SWAP bit5$, bit8$π bit7$ = PseudoNOT$(bit7$)π CASE 13π SWAP bit1$, bit6$π bit2$ = PseudoNOT$(bit2$)π SWAP bit3$, bit8$π bit4$ = PseudoNOT$(bit4$)π bit5$ = PseudoNOT$(bit5$)π bit7$ = PseudoNOT$(bit7$)π CASE 14π SWAP bit2$, bit7$π SWAP bit4$, bit5$π CASE 15π bit1$ = PseudoNOT$(bit1$)π SWAP bit2$, bit4$π bit3$ = PseudoNOT$(bit3$)π bit7$ = PseudoNOT$(bit7$)π bit8$ = PseudoNOT$(bit8$)π CASE 16π SWAP bit1$, bit6$π SWAP bit2$, bit7$π SWAP bit3$, bit8$π SWAP bit4$, bit5$π CASE 17π bit1$ = PseudoNOT$(bit1$)π SWAP bit2$, bit4$π bit3$ = PseudoNOT$(bit3$)π bit5$ = PseudoNOT$(bit5$)π SWAP bit6$, bit8$π bit7$ = PseudoNOT$(bit7$)π CASE 18π SWAP bit1$, bit2$π bit3$ = PseudoNOT$(bit3$)π SWAP bit4$, bit8$π SWAP bit5$, bit7$π bit6$ = PseudoNOT$(bit6$)π CASE 19π SWAP bit1$, bit5$π bit2$ = PseudoNOT$(bit2$)π bit3$ = PseudoNOT$(bit3$)π SWAP bit4$, bit6$π bit7$ = PseudoNOT$(bit7$)π bit8$ = PseudoNOT$(bit8$)π CASE 20π SWAP bit1$, bit8$π bit2$ = PseudoNOT$(bit2$)π bit3$ = PseudoNOT$(bit3$)π bit4$ = PseudoNOT$(bit4$)π bit5$ = PseudoNOT$(bit5$)π bit6$ = PseudoNOT$(bit6$)π bit7$ = PseudoNOT$(bit7$)π END SELECTπ base2$ = bit1$ + bit2$ + bit3$ + bit4$ + bit5$ + bit6$ + bit7$ + bit8$π decimal% = MakeDecimal%(base2$)π MessWithByte$ = CHR$(decimal%)πEND FUNCTIONππFUNCTION PseudoNOT$ (bit$)π IF bit$ = "1" THENπ PseudoNOT$ = "0"π ELSEπ PseudoNOT$ = "1"π END IFπEND FUNCTIONππSUB SaveImage (saveme%())π FOR counter% = 0 TO 4001π saveme%(counter%) = PEEK(counter%)π NEXT counter%πEND SUBππSUB Shadow (urr%, urc%, llr%, llc%, lrr%, lrc%)π FOR counter% = ConvBlock%(urr%, urc%, 1) TO ConvBlock%(lrr%, lrc%, 1) STEP 160π POKE counter%, ConvColor%(8, 0)π NEXT counter%π FOR counter% = ConvBlock%(llr%, llc%, 1) TO ConvBlock%(lrr%, lrc%, 1) STEP 2π POKE counter%, ConvColor%(8, 0)π NEXT counter%πEND SUBππSUB StatusLine (message$, sector$)π display$ = SPACE$(72)π area$ = SPACE$(7)π LSET display$ = message$π RSET area$ = sector$π total$ = display$ + "│" + area$π FOR counter% = 1 TO 80π POKE ConvBlock%(25, counter%, 1), ConvColor%(7, 4)π NEXT counter%π FOR counter% = 1 TO 80π POKE ConvBlock%(25, counter%, 0), ASC(MID$(total$, counter%, 1))π NEXT counter%πEND SUBπJonathan Leger XOR ENCRYPTION/DECRYPTION leger@mail.dtx.net 08-10-96 (12:55) QB, QBasic, PDS 168 6372 XOR.BAS '(*** XOR.BAS ***)π'(*************************************************************************)π'(*** This is a small demonstration of the XOR encryption/decryption ***)π'(*** method that will encrypt this file (assuming the name is XOR.BAS) ***)π'(*** and put it in the file XOR.XOR. If you want it to decrypt the ***)π'(*** XOR.XOR file once it's been encrypted, merely change the FILE$ ***)π'(*** to XOR.XOR and the OUTPUT$ to XOR.BAS (or whatever). The key ***)π'(*** we will be using is 15. You can change that for your purposes, ***)π'(*** but the key must be a value from 0 to 255. ***)π'(*************************************************************************)π'(*** This method of encryption is not very secure, since it can be ***)π'(*** broken easily by the brute force method (though it used to be a ***)π'(*** very popular form of encryption). However, for most purposes, ***)π'(*** such as game high scores or passwords, etc, it serves quite well, ***)π'(*** since the person has no way to know that the file was encrypted ***)π'(*** using this method, and most people wouldn't think to try and ***)π'(*** decrypt it themselves anyway. ***)π'(*************************************************************************)π'(*** The File.XOR function returns a FALSE value (0) if the input file ***)π'(*** (FILE$) does ***) not exist, otherwise it returns TRUE (-1). ***)π'(*************************************************************************)ππDECLARE FUNCTION File.XOR% (FILE$, output$, ekey%, sbarx%, sbary%, sbarlen%)ππSCREEN 0πWIDTH 80, 25πCOLOR 7, 0πCLSππFILE$ = "xor.bas" '(*** We'll encrypt this file... ***)πoutput$ = "xor.xor" '(*** ...and put the results here. ***)πekey% = 15 '(*** Our encryption key will be 15. ***)ππLOCATE 1, 1πPRINT "Using XOR method of encryption/decription on " + UCASE$(FILE$) + "..."ππ'(*** Use a status bar for the encryption. ***)πCOLOR 15, 1πErrVal = File.XOR%(FILE$, output$, ekey%, 1, 2, 40)ππIF ErrVal THEN '(*** No errors! ***)π LOCATE 1, 1: COLOR 7, 0π PRINT STRING$(80, " ");π LOCATE 1, 1π PRINT "Success! Results in file (" + UCASE$(output$) + ")."πELSEπ '(*** The file didn't exist! ***)π LOCATE 1, 1: COLOR 7, 0π PRINT STRING$(80, " ");π LOCATE 1, 1π PRINT "Input file ("; UCASE$(FILE$); ") does not exist."πEND IFππDEFINT A-Zπ'(*** File.XOR () ****)π'(*** ----------- ****)π'(*** Thie function will take a file (INPUT$) and XOR each byte with ***)π'(*** the given encryption key (EKEY), puting the results into a file ***)π'(*** (OUTPUT$). If you want a status bar showing progress, pass the ***)π'(*** x and y location of the status bar on-screen (SBARX, SBARY). If ***)π'(*** no status bar is desired, pass a 0 for the x and y. SBARLEN is ***)π'(*** the length you want the status bar to be. ***)π'(*** NOTICE: To unXOR the file, just pass the XORed file the the ***)π'(*** function with the _SAME_ encryption key. Given the nature of ***)π'(*** XOR, an individual decryption scheme is not needed. Note, too, ***)π'(*** that EKEY can only be from 0 to 255. ***)π'(*** --------------------------------------------------------------- ***)πFUNCTION File.XOR (FILE$, output$, ekey, sbarx, sbary, sbarlen)ππ'(*** Check if the input file passed exist. ***)π'(*** If the input file doesn't exist, exit with error ***)π'(*** value 0 [FALSE]. ***)πfilenum = FREEFILEπOPEN FILE$ FOR BINARY AS filenumππIF LOF(filenum) = 0 THENπ '(*** Pass error value back since file didn't exist. ***)π File.XOR = 0π CLOSE filenumπ '(*** Kill the 0 byte file we made by opening it. ***)π KILL FILE$π EXIT FUNCTIONπEND IFππ'(*** Both files exist, open them. ***)πCLOSE filenumπOPEN FILE$ FOR INPUT AS filenumπoutputnum = FREEFILEπOPEN output$ FOR OUTPUT AS outputnumππ'(*** If we want a status bar, do the encryption with a status bar! ***)πIF sbarx > 0 THENπ '(*** Draw empty status bar and reset the byte count# to 0. ***)π LOCATE sbary, sbarx: PRINT STRING$(sbarlen, 177);π count# = 0π '(*** Encrypt/Decrypt the file. ***)π DO WHILE NOT EOF(1)π π '(*** Read a byte from the file. ***)π bytes.left# = LOF(filenum) - LOF(outputnum)π IF bytes.left# < 100 THENπ read.bytes$ = INPUT$(bytes.left#, filenum)π chunk = bytes.left#π ELSEπ read.bytes$ = INPUT$(100, filenum)π chunk = 100π END IFπ π '(*** Increment byte count#. ***)π count# = count# + chunkππ '(*** XOR the bytes with encryption key. ***)π FOR byte.count = 1 TO chunkπ changed.byte$ = changed.byte$ + CHR$(ASC(MID$(read.bytes$, byte.count, 1)) XOR ekey)π NEXT byte.countπ π '(*** Print it to the output file. ***)π PRINT #outputnum, changed.byte$;π changed.byte$ = ""ππ '(*** If a chunk of 100 bytes has been read, update status bar. ***)π IF count# MOD 1000 = 0 THENπ LOCATE sbary, sbarxπ PRINT STRING$(sbarlen * (count# / LOF(1)), 219);π END IFππ LOOPπ π LOCATE sbary, sbarxπ PRINT STRING$(sbarlen, 219);ππELSEπ'(*** We didn't want a status bar, so skip the status bar. This will ***)π'(*** give some extra speed because the print code is ignored. ***)π π DO WHILE NOT EOF(1)π π '(*** Read a byte from the file. ***)π bytes.left# = LOF(filenum) - LOF(outputnum)π IF bytes.left# < 100 THENπ read.bytes$ = INPUT$(bytes.left#, filenum)π chunk = bytes.left#π ELSEπ read.bytes$ = INPUT$(100, filenum)π chunk = 100π END IFπ π '(*** XOR the bytes with encryption key. ***)π FOR byte.count = 1 TO chunkπ changed.byte$ = changed.byte$ + CHR$(ASC(MID$(read.bytes$, byte.count, 1)) XOR ekey)π NEXT byte.countπ π '(*** Print it to the output file. ***)π PRINT #outputnum, changed.byte$;π changed.byte$ = ""ππ LOOPππEND IFππ'(*** Close the files we used. ***)πCLOSE filenum, outputnumππ'(*** All done with no errors, so return a TRUE value. ***)πFile.XOR = -1ππEND FUNCTIONππKurt Kuzba 8-BIT TO 6-BIT ENCODER/DECODER FidoNet QUIK_BAS Echo 06-01-96 (00:00) QB, QBasic, PDS 44 1821 826_BIT.BAS '> But my question is: Can we talk about and share code forπ'> en/decoders? Since this topic is on my mind anyway, hasπ'> anyone programmed a MIME-en/decoder and/or a UUEn/Decoder?π'>........................................π' One of the simplest forms of encoding to text is to convertπ'from an 8-bit value to 6-bit. This allows you to have threeπ'normal ASCII characters coverted to four characters within theπ'range of the lower, message format usable, ASCII. Try this:π'_|_|_| 826_BIT.BASπ'_|_|_| This program demonstrates one method of encoding dataπ'_|_|_| to conform to low ASCII requirements by turning threeπ'_|_|_| 8-bit values into four 6-bit values and vice-verse.π'_|_|_| No warrantees or guarantees are given or implied.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (6/1/96)πDECLARE FUNCTION ENCODE$ (Bytes3$)πDECLARE FUNCTION UNCODE$ (Bytes4$)πPRINT : PRINTπtest$ = CHR$(176) + CHR$(177) + CHR$(178)πPRINT test$, ENCODE$(test$), UNCODE$(ENCODE$(test$))πtest$ = CHR$(254) + CHR$(219) + CHR$(129)πPRINT test$, ENCODE$(test$), UNCODE$(ENCODE$(test$))πtest$ = CHR$(17) + CHR$(21) + CHR$(7)πPRINT test$, ENCODE$(test$), UNCODE$(ENCODE$(test$))πtest$ = "ABC"πPRINT test$, ENCODE$(test$), UNCODE$(ENCODE$(test$))πFUNCTION ENCODE$ (Bytes3$)π Result$ = "": B& = 0π FOR t% = 3 TO 1 STEP -1π B& = B& * 256 + ASC(MID$(Bytes3$, t%))π NEXTπ FOR t% = 1 TO 4π Result$ = Result$ + CHR$(48 + (B& AND 63)): B& = B& \ 64π NEXT: ENCODE$ = Result$πEND FUNCTIONπFUNCTION UNCODE$ (Bytes4$)π Result$ = "": B& = 0π FOR t% = 4 TO 1 STEP -1π B& = B& * 64 + ASC(MID$(Bytes4$, t%)) - 48π NEXTπ FOR t% = 1 TO 3π Result$ = Result$ + CHR$(B& AND 255): B& = B& \ 256π NEXT: UNCODE$ = Result$πEND FUNCTIONπ'_|_|_| end 826_BIT.BASπEdward Di Geronimo Jr. CHANGE FREQ OF SYSTEM TIMER FidoNet QUIK_BAS Echo 07-07-96 (00:00) QB, QBasic, PDS 68 2347 INTCLOCK.BAS'Here's some almost working code to get more precise timing inπ'QuickBasic. It works by changing the internal timer to generate anπ'interrupt more often than 18.2 times per second. To use this code, callπ'the ChangeTimer function, and to get the desired frequency use thisπ'formula:ππ' 1.19318mhzπ'-----------------π'desired freuqencyππ'18.2 comes about by dividing by 65535 (highest 16bit number).ππ'If you look at the code, you'll notice there are COUNTER0, 1, and 2π'constants. Counter 0 is the frequency of the system timer (which weπ'change), counter 1 is the ram refresh rate (don't change!), and counterπ'2 is related to the pc speaker (I doubt you should touch it).ππ'I know this works in C, but I don't know how well it will work in QB.π'It should effect the TIMER value. It would be great for games if weπ'could write our own ISR's to accompany this, but QB doesn't haveπ'pointers, let alone sub/function pointers, so we can't. Oh well. But ONπ'TIMER should be effected by this, so I guess we don't need one. I'llπ'leave it to you guys to figure it out.ππ'Code to change the frequency of the 8253 clock chip's interruptπ'generation. Public domain (C) by Edward Di Geronimo Jr. 7/7/96ππDEFINT A-ZππDECLARE SUB ChangeTimer (NewCount%)ππCONST CONTROL8253 = &H43 ' the 8253's control registerπCONST CONTROLWORD = &H3C ' the control word to set mode 2π ' binary least/mostπCONST COUNTER0 = &H40 ' counter 0πCONST COUNTER1 = &H41 ' counter 1πCONST COUNTER2 = &H42 ' counter 2ππCONST TIMER60HZ = &H4DAE ' 60 hzπCONST TIMER50HZ = &H5D37 ' 50 hzπCONST TIMER40HZ = &H7486 ' 40 hzπCONST TIMER30HZ = &H965C ' 30 hzπCONST TIMER20HZ = &HE90B ' 20 hzπCONST TIMER18HZ = &HFFFF ' 18.2 hz (the standard count and the slowest possible)πChangeTimer TIMER60HZππDO WHILE INKEY$ = ""π A# = TIMERπ PRINT A#,π WHILE A# = TIMER: WENDπLOOPππChangeTimer TIMER18HZππSUB ChangeTimer (NewCount)π' send the control word, mode 2, binary, least/most load sequenceππOUT CONTROL8253, CONTROLWORDππ' now write the least significant byte to the counter registerππOUT COUNTER0, NewCount AND &HFF ' LOWBYTE(newcount)ππ' and now the the most significant byteππOUT COUNTER0, (NewCount AND &HFF00) / 256 ' HIGHBYTE(newcount)ππEND SUBπKevin J. Krumwiede LINEAR DATE FidoNet QUIK_BAS Echo 07-12-96 (01:22) QB, QBasic, PDS 64 1834 LIN_DATE.BAS' Hello everybody! This program reports the current linear date, π' expressed as the number of seconds since 00:00 on 01-01-1970. π' This could be used the same way you might use TIMER to create π' delays, but without the complications of midnight rollover. π' This seems to be pretty fast, though I'm sure there's room for π' optimization. I think I corected properly for all the special π' cases (leap years, etc.), but if you spot any errors, please π' let me know! Here it is: π π' ********************************************************************* π' lin_date.bas π' Written and released to the PUBLIC DOMAIN by Kevin J Krumwiede π' Calculates the linear date from 01-01-1970 as per the Unix convention π' ********************************************************************* π πDECLARE FUNCTION linearDate& () πDECLARE FUNCTION leapDays% (year%) π πCLS πPRINT "Current Linear Date:"; πPRINT linearDate& π πEND π πFUNCTION leapDays% (year%) π πIF (year% MOD 100 = 0) AND (year% MOD 4 <> 0) THEN π leapDays% = 0 πELSEIF (year% MOD 4 = 0) THEN π leapDays% = 1 πELSE π leapDays% = 0 πEND IF π πEND FUNCTION π πFUNCTION linearDate& π πdt$ = DATE$ πm% = VAL(LEFT$(dt$, 2)) πd% = VAL(MID$(dt$, 4, 2)) πy% = VAL(RIGHT$(dt$, 4)) π πDIM days(1 TO 12) AS INTEGER πdays(1) = 31: days(2) = 28: days(3) = 31: days(4) = 30 πdays(5) = 31: days(6) = 30: days(7) = 31: days(8) = 31 πdays(9) = 30: days(10) = 31: days(11) = 30: days(12) = 31 π πlin& = 0 πFOR i% = 1970 TO y% - 1 π lin& = lin& + 86400 * (365 + leapDays(y%)) πNEXT i% π πFOR i% = 1 TO m% - 1 π lin& = lin& + 86400 * days(m%) πNEXT πIF m% > 2 THEN lin& = lin& + 86400 * leapDays(y%) π πlin& = lin& + 86400 * (d% - 1) πlin& = lin& + TIMER π πlinearDate& = lin& π πEND FUNCTION πEgbert Zijlema CONTINUALLY DISPLAY ACTUAL TIMEE.Zijlema@uni4nn.iaf.nl 07-21-96 (22:02) PB 225 7164 SHOWTIME.BAS' SHOWTIME.BAS ---- continuatedly displays the actual timeπ' Author : Egbert Zijlema (E.Zijlema@uni4nn.iaf.nl)π' Date : July 21, 1996π' Language : Power Basic 3.2π' Copyright status: Public Domainππ' Info:π' Most of the time a program is just waiting for user activityπ' (e.g. keyboard input). These "pauses" are the most excellentπ' moments to display the actual time. For instance at the menu bar.π' There is only 1 restriction: the Basic commands LOCATE and/or PRINTπ' should ALWAYS serve the user, so your program must write (POKE) theπ' time information directly to video memory.ππ' In this demo a sample menu lets you toggle between different formats:π' hh:mm:ss (the default TIME$)π' hh:mm (including a blinking colon)π' 12/24 hrs system, adding AM or PM for 12 hrsππ' For computers with vga card there is an extra font to displayπ' the time in 'digital' form. These font (earlier released asπ' "LOADFONT.BAS") includes the characters 0 - 9, A, P and M. Theyπ' will temporaryly replace the characters 224 throug 238 of theπ' default ASCII set. It is to be restored while quitting.π' ---------------------------------------------------------------------ππDEFINT A - Zππ%NO = 0 : %YES = NOT %NO ' equates true/false (0/-1)ππ%AX = 1 : %BX = 2 : %CX = 3 ' equates for ...π%DX = 4 : %BP = 7 : %ES = 9 ' ... registersππTYPE CLOCKFLAGSπ twelve AS INTEGER ' 12 hrs clockπ secs AS INTEGER ' show secondsπ font AS INTEGER ' use special fontπEND TYPEππTYPE FLAGSπ mono AS INTEGER ' monochrome screenπ vga AS INTEGER ' ega/vga card presentπEND TYPEππDIM clok AS SHARED CLOCKFLAGSπDIM flg AS SHARED FLAGSπDIM VideoAddress AS SHARED INTEGERππIF (pbvScrnCard AND 1) = 0 THEN ' test card typeπ VideoAddress = &HB800 ' color cardπELSEπ VideoAddress = &HB000 ' monochromeπ flg.mono = %YESπEND IFππIF BIT(pbvScrnCard, 4) THEN ' is it a vga-card as well?π LoadFont ' load special charsπ flg.vga = %YES ' vga modifications done!πEND IFππSUB LoadFontπ cred$ = CHR$(126, 129, 189, 165, 161, 165, 189, 129, 126)π phon$ = CHR$( 0, 0, 0, 126, 255, 153, 60, 126, 126)π zero$ = CHR$( 56, 198, 198, 198, 0, 198, 198, 198, 56)π one$ = CHR$( 24, 24, 24, 24, 0, 24, 24, 24, 24)π two$ = CHR$( 56, 198, 6, 6, 56, 192, 192, 192, 62)π thre$ = CHR$( 56, 198, 6, 6, 56, 6, 6, 198, 56)π four$ = CHR$(198, 198, 198, 198, 56, 6, 6, 6, 6)π five$ = CHR$( 62, 192, 192, 192, 56, 6, 6, 198, 56)π six$ = CHR$(192, 192, 192, 192, 56, 198, 198, 198, 56)π sevn$ = CHR$(248, 6, 6, 6, 0, 6, 6, 6, 6)π eigt$ = CHR$( 56, 198, 198, 198, 56, 198, 198, 198, 56)π nine$ = CHR$( 56, 198, 198, 198, 56, 6, 6, 198, 56)π a$ = CHR$( 56, 198, 198, 198, 56, 198, 198, 198, 198)π p$ = CHR$( 56, 198, 198, 198, 56, 192, 192, 192, 192)π m$ = CHR$(126, 219, 219, 219, 0, 219, 219, 195, 195)ππ start$ = STRING$(3, 0) ' align topπ tail$ = STRING$(4, 0) ' align tailπ between$ = STRING$(7, 0) ' align prev. and next charππ ' NOTE: if the characters don't bottom align versus defaultπ ' font characters (e.g. the colon) then unmark the next line:ππ ' SWAP start$, tail$ππ pattern$ = start$ + cred$ + between$ + phon$ + between$ + zero$ + _π between$ + one$ + between$ + two$ + between$ + thre$ + _π between$ + four$ + between$ + five$ + between$ + six$ + _π between$ + sevn$ + between$ + eigt$ + between$ + nine$ + _π between$ + a$ + between$ + p$ + between$ + m$ + tail$ππ REG %AX, &H1100 ' functionπ REG %BX, 16 * 256 ' 16 bytes per char in BHπ REG %CX, 15 ' number of charactersπ REG %DX, 224 ' first char in ASCII-set to modifyπ REG %ES, STRSEG(pattern$)π REG %BP, STRPTR(pattern$)π CALL INTERRUPT &H10π REG %AX, &H1103 ' functionπ REG %BX, 0π CALL INTERRUPT &H10πEND SUBππ' Trim all spaces from both ends of a stringπFUNCTION TRIM(BYVAL text AS STRING) AS STRINGπ FUNCTION = LTRIM$(RTRIM$(text))πEND FUNCTIONππFUNCTION TimeToDisplay AS STRINGπ temp$ = TIME$π IF NOT clok.secs THEN temp$ = LEFT$(temp$, 5) ' skip secondsπ hour = VAL(LEFT$(temp$, 2))π extension$ = SPACE$(3)ππ IF clok.twelve THENπ SELECT CASE hourπ CASE => 12π IF hour > 12 THEN DECR hour, 12π extension$ = " PM"π CASE ELSEπ IF hour = 0 THEN hour = 12π extension$ = " AM"π END SELECTπ END IFππ temp$ = TRIM(STR$(hour)) + MID$(temp$, 3) + extension$π temp$ = temp$ + SPACE$(11 - LEN(temp$) ) ' fixed length = 11 charsππ IF clok.font THENπ FOR count = 48 TO 57π REPLACE CHR$(count) WITH CHR$(count + 178) IN temp$π NEXTπ REPLACE CHR$(65) WITH CHR$(236) IN temp$π REPLACE CHR$(80) WITH CHR$(237) IN temp$π REPLACE CHR$(77) WITH CHR$(238) IN temp$π END IFππ FUNCTION = temp$πEND FUNCTIONππSUB TimeInfoπ STATIC colonπ IF flg.mono THENπ attri = 112 ' black on whiteπ ELSEπ attri = 121 ' blue on whiteπ END IFππ Info$ = TimeToDisplayπ IF colon = %NO AND clok.secs = %NO THENπ REPLACE ":" WITH CHR$(32) IN Info$π colon = %YESπ ELSEπ colon = %NOπ END IFππ NextChar = 1ππ DEF SEG = VideoAddressπ FOR offset = 102 TO 122 STEP 2 ' 11 characters + 11 colorsπ character = ASC(MID$(Info$, NextChar, 1))π POKE offset, characterπ POKE offset + 1, attriπ INCR NextCharπ NEXTπ DEF SEGπEND SUBππFUNCTION GetKeyπ STATIC lastTime$ππ DOππ IF TIME$ <> lastTime$ THEN ' every secondπ lastTime$ = TIME$π TimeInfoπ END IFππ LOOP UNTIL INSTATππ FUNCTION = CVI( INKEY$ + CHR$(0) )πEND FUNCTIONππSUB DemoMenuππ ' menu textπ COLOR 7, 0π IF flg.vga THENπ LOCATE 3, 4π PRINT "F1 = toggle fonts"π END IFπ LOCATE 4, 4 : PRINT "F2 = toggle seconds"π LOCATE 5, 4 : PRINT "F3 = toggle 12/24 hrs"π LOCATE 6, 4 : PRINT "Esc = end of this demo"ππ DOπ KeyIn = GetKeyπ SELECT CASE KeyInπ CASE 27π IF flg.vga THEN SCREEN 0, 0, 0, 0 ' restore default fontπ CLSπ SYSTEMπ CASE 59 * 256 ' F1π IF NOT flg.vga THEN EXIT SELECTπ IF clok.font THEN clok.font = %NO ELSE clok.font = %YESπ CASE 60 * 256 ' F2π IF clok.secs THEN clok.secs = %NO ELSE clok.secs = %YESπ CASE 61 * 256 ' F3π IF clok.twelve THEN clok.twelve = %NO ELSE clok.twelve = %YESπ END SELECTπ LOOPπEND SUBπππ' demo mainππCLSπ COLOR 0, 7π LOCATE 1, 1 : PRINT SPACE$(80); ' dummy menu barπ LOCATE 1, 4 : PRINT "Sample Menu Bar"ππ clok.secs = %YES ' start with default TIME$π CALL DemoMenuπENDπEgbert Zijlema TRAP KEYBOARD INACTIVITY E.Zijlema@uni4nn.iaf.nl 08-19-96 (19:53) PB 99 2673 NOKEY.BAS ' NOKEY.BAS - how to trap keyboard inactivityπ' Author : Egbert Zijlema (E.Zijlema@uni4nn.iaf.nl)π' (up)Date : August 19, 1996π' Language : Power Basic 3.2π' Copyright : Public Domainππ' This routine does not demonstrate a sophisticated screen saver.π' Its main purpose is to show the most simple method to trap keyboardπ' inactivity for a certain period of time.π' As a sample screen saver it turns the screen black, just to proofπ' that it really works.ππ' Most programmers use the TIMER FUNCTION to calculate the number ofπ' seconds before screen saver launch. This works. I used it myselfπ' until an hour ago. There is 1 small problem however: as soon asπ' the computer's clock passes midnight, TIMER is (re)set to zeroπ' which will cause an infinite loop - unless you correct it byπ' adding 86400 seconds every round, e.g.:ππ' start# = TIMERπ' DOπ' now# = TIMERπ' IF now# < start# THEN INCR now#, 86400 [ adjust for midnight]π' IF now# - start# => .... THENπ' (command to start screen saver)π' END IFπ'π' (code for keyboard trapping)π' LOOP UNTIL ........ππ' ---------------------------- begin code ---------------------------ππDEFINT A - ZπFUNCTION GetKey AS INTEGERπ STATIC t$ ' alias for TIME$π DOππ IF seconds = 30 THEN ' half a minute for this demoπ CALL BlackScreen ' start screen saverπ EXIT FUNCTIONπ END IFππ IF t$ <> TIME$ THEN ' TIME$ changes every secondπ t$ = TIME$π LOCATE 1, 72 : PRINT t$ ' you may leave this outπ INCR seconds ' add 1π END IFππ KeyIn$ = INKEY$π LOOP UNTIL LEN(KeyIn$) ' until keypressππ FUNCTION = CVI( KeyIn$ + CHR$(0) )πEND FUNCTIONππSUB BlackScreenπ DEF SEG = &HB800 ' color card - use &HB000 for monochromeπ OldScreen$ = PEEK$(0, 4000)π COLOR 7, 0π LOCATE , , 0 ' hide cursorπ CLSπ DOπ LOOP UNTIL LEN(INKEY$)π POKE$ 0, OldScreen$π DEF SEGπEND SUBππSUB MainMenuπ DOπ KeyIn = GetKeyπ SELECT CASE KeyInπ CASE 27π CLSπ SYSTEMπ CASE ELSEπ ' other keys not supported hereπ END SELECTπ LOOPπEND SUBππ' mainππCLSπ COLOR 15, 0π LOCATE 2, 4π PRINT "NOKEY.BAS - traps keyboard inactivity"π LOCATE 3, 4π PRINT "Author : Egbert Zijlema"π LOCATE 4, 4π PRINT "Copyright status: Public Domain"π LOCATE 10, 4π PRINT "This screen will turn black after 30 seconds"π LOCATE 11, 4π PRINT "Press any key to restore it"π COLOR 7π LOCATE 14, 4π PRINT "(or press Esc to finish this demo)"ππ MainMenuπENDπErik Bruggema SPACE SHOWER DEMO immsstok@worldaccess.nl 08-15-96 (13:41) QB, PDS 94 6196 SPACE.BAS DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"SPACE.ZIP",4^6:Z&=4375:?STRING$(50,177);πU"%up()%9%%%%-%oCd1FzC<ib13%%%#R%%%.%%%%xu%fhjS[gfx>k)dASZA/w\bzuπU")rT,3:2n?U<FGf=hEfBE;+FV1eEIaLx,\tE^O.)I>nOITHy-=(([r(#cuLml-z*πU"4t;<P>+6yp3#)bM-f>,?3Pcks26WO8I_mTA]FMSco8gA*[JK4/nrFP74h$4Bu:_πU"NY'ePvnpbo0DAj#aW(HJx4#&=,5I/8ZaAx<A9o?&CG2hZ\uXHnEOWSu>QTv*BS/πU"Xc5tLet/d#[K$0,2)D&)BhdrJJDqFseut<WQe/kyGGmu:o4PRi;%ul4mU\,$VVlπU"SE++f+17/<h,qDs'&)\30O#fkK03(Z_(H^HCv>YI]&pB+&\Cs&F%3&ITs.vU2<7πU"IcQM.Ej=QfnS'G2G(cI'9tZ>Qjal*sa*o?WWlf>V5GjGha*D5J.,DN#q.+=L$2(πU"WhcY;)6Id5478U/iCa/Ol]pJqpMWUuQUQGo-_no.jhN*lTvB&K'<]*6TE2$%$$QπU"Y6vjV%q=;L+PL1EU#[#jukUW3SXfTv>m7f-:?fI5(?DjfflarFYB251KNTEXVhKπU"^PVBU5>nLK<?K1,6M&isl;gofd'cgKc-73UVCC+omxNE+&Cymqg0V-f:fC/Ygi-πU"tIOC]>/g.2.2$3]*YZ835=9qYAF'U,p='47F\[hjF#&K'(>wf_j2?xWTZDcv06qπU"Enjg8OvM9=BrQV&:U^3J1X5zF\K4(ndV=z9aS8**4u[;v(QBUmVTt.Z0P.Q-D'QπU"7D3a/9[f7qahN^;&?WhU<.m*\l8ml>TswbQ,ZL;?_tm6O,td2L$i*-h(Da6;v.6πU"t*$]uxsgql$ZHlCN$q?<Sp&+,QsVrJ/Y$vC;stbf7&]'i)8?r?ppWT_.inu$Bt-πU"+*<gAI%pPLHVAINBhhoS;qXHWQSC+aP+kA#[3km&82Tidm0%mA\)vt_aPk>ZY]HπU"*C:0_<V.H=2Ll$eW,JJ8u9O5\%]QS_CRXn-Jz(K>V0#gCL$Ip_Uk1bV/sRe<]u.πU"0wYaAwVepJ-UCj)r[Q+qrr8.>iZOorATf$ajWNU77Uj+b6hiwE?l<e,.]tIo'uuπU"_R4Ct-vR40[v8Y>ljPYLBb%ycnR9Wnm;Xwd<q6C9=p?y2x[MqUDv,6ohomj,/]&πU"-7F/bc9GVjdGu=W4r8y^JIbfGso8Lmp\;kD7oXtgr#IwCAc:x8BLh.BH,bBb.8KπU"y^r6QiS4jq1'j%V7O)UA[w&AdnG$K+YaK74Mv-L6#Gb9BqJY8hbG]:3=O1n54CmπU"A^JoWouvaYjogvi1]d%y%olgb'cROhMkeBA.UIK_r2nGDenJ[1GN1tK-?Ia5UTBπU"H3?k)Y'1ir_dPaJsY*2J_hbuBo8M#uV>#8j*9>0xZc9_7Zp%UrCe&?r9SU*/KH]πU"Ka%-_^#bK%EqC8p%Xbw4Fbb.69\3oq+7HvL1<r+$;/k5hBP1hgzCJj&wwBrugJkπU"Ks6SGU1WtkcF5*6q/6X$DMKYvTE[?'tqWs1hOD*p>-1gU&B7pJ^gAU[7_COUb.EπU"?mJ<+PBJGHXHPK=]\oK(5h_&h1[fKvSPy,QB=5#nL9K8nm*,:n4aTH7Y>,*jWrpπU"5v*.j1w??i($O7o'7tRXn8OmF<gbQH/d,1z)qK9xAp:i>R/%[_5n8#e:]Y[lpOaπU"v3Qi=;X%L9lMBAM#WDVAJuauvKoLKSOqIHybHk+]j2<V'3Kp>;j32.a,4fU<sf5πU"$-Lxf-ztjSY?S[8ziEVHh#CgovumCQ:b1MjyodJ^lmCt#/1o2K*;NW)0D<]Yc78πU"f%oCD7J)=uxek7goIl4^B,_q5J+PfXVs-Z][U6.4;2wQJUaz((ZL;s178NQ<JFeπU"==5kOxcu.53bH*pb,C&mG3#;n3J$\yk.C2So6GhD8;[Q^::BVrJ'FUE,hEZs(KOπU"rf<p;a]8Ui?Ui5qNVNFB2rv:29IWMfS:>e7n40Ft>^$^asr04V>B1a=f&[aNpm(πU"6VH>_.j(1uzOUtkZoD>7kz0G$6[99]t+g8KaB;%g]Gsd]Zjhuo,**B.sp,J>kaMπU"G[RL6&JWtnSY'plRqtOcddLC[1d=3tpft\cTiOtWD82h(lI_U+noKZ<fS'+Cj=QπU"VT?q#MguKqO.QGL&<tJ5h%pTV^M#u\[Qgb6C]-4%$Jf^p)tK28Cp2JxWC2DA>VDπU"g-;8)$'\Zm_B8udFXTV6lgHI_T)GmizCZC6t9BX['AG*QUw5<;6cmQ:+RPQhUUmπU"Exvb\hu:&.s7oH'<$^EFGg'*]&:^(8DJ&8Qh_\g7GTS0+eFF5UXhGfe-tRA_#;dπU"2;_bWWB6UgGFlro=4=%^6bO=RuZMy18T+MW17HsnZc,G-TX$JPKFXgCUf3BAiA#πU"t%G/]OKGvB,\UC+%9XZK<>]LkfSD),kY8)oA2W.4]Ji&$UI3l/u*p,+DgENnd3WπU"*c-0\/t>,QNqgdP_nG=+iHO-acP:#HwQMc/V/R'W8jc8Jiif^PEl%CM*/g=vyLmπU"7c&(JZfSf^^bq/d8gsBeu^a*=G:trNoWgDk3JcaAe-nW#&JnKnPS[:Sf7s<qLw+πU"&ZPva.Am^-Q83CUh&,$ijibtmK=?eA$;Tp-#?iKPi?Ofp)7fM6XQ&?s=APC*,wPπU"O97;&^N(8b<4/s;4n(0TrWAF'aAu0.7:+\VT\uGY?w0E-k%scs/B:qYFte3z<JgπU"=A4X)3b(cm3hh\alT7g)c#r]%v<cy)Ax-p;-+/BM1UB#p?3FZ^5=,T[&)\W;G7:πU"2iLlZm0%#d*AvRit3-f*0bH;f4CQYoQp*p$T7'_SEjWfv9RcBrtg<y9e9>[fW[/πU"o%UpoKtS)5g,Q7oDgehA<=Y<^0L>QSv*JbOt7(a])(tQEc7qo?^)'Kf9E?LXsy&πU"T]G12TM'IA?(6=RS,9OB?S9u%SL8Srb*H\vI$evhCD<ULuX5\7XwUFs&m#bFszGπU"A>ex:f^j6bZUI1>CA,Be3g*#BFxTKE7tBu\$&qSkUq+T_jUXRD0Rae>NIXynN7hπU"i]:*[\d-:AEhd07K:ahb'jGoK'$3#r\$>Qi,W1-\(anGXJlt%[A&>29^f1zSQ5>πU"ghZ0]WDY,CXep]J'0VAiDK*17CLDUl0'5WM&X5?uAUFpd5gdVXV+kaUPN.z)u8yπU"ho?i6&a7JZ<NzjNP?,r&lmrFWGnW35]bi;lKg)P?f\,FP'b+O)n>g8.*FUeAIT'πU"7X4^RpKO3eP99Xjiq$5Ht<Xj%GwFwuEl_Ss8Bi=YX.3X-hZea?_0-_h'A7g)f\SπU")pO'G)\c^lTiX;6&FcMBAPFSgUf)wj\Kf3=Sr'vkgxu?k;]<=_QCqwj]SbdeVuYπU"#[C%Vs5di]#+g5t*v$QZ:3[L5AU^o/:8R8pDbd(kXd^h)Tu*S,Mje..H*?D+mOjπU"mZASj/)SJ]W^_E5*=/6C6n6s9+5\4p\$tl8wcNB_X<\tQ4o(I3Oua,Amum3JfEvπU"]22(<[k&UhdFPlOd885B8s7K&2Bm=wujp:A$k.J1y*Z?852ZE<jg0UYun4-ZPM\πU"nGbfr=U-(h]qUYV.tqYTF07OYXh(Vi[c0bfOO:G?>RFcs&0l[z8xLdq%oNY)^2-πU"m2KBwb9l/)#YL7&elAnT[xcNNK.Z3U%&J3w:>AItyhCIY:4E_x_bmw/FWQWKEz;πU"W>'<GQ\3Uk2D]7NUB;XM14d(Pr-smnyRld%v9=c3UlZ[K(VXgoj/,75zPzTAxdxπU",M7rtK_4>Ti^ul'^(ASP8I$YTEER%1/oIu/RZCjZ7C4=k*V>Bb]Mj/<gLFAuP-FπU"\4eVI$A?:kQa:$vs:ES)5Qr%4h#Q%KN+r)T7s42Lb*k4\n)Lev183eWR2T?a.GWπU"A(_kZfkiwIYxN<1F3WhtbkDFd5b;zdaP5wCT&FoO7nk*t=nSXPDez-CT(y?gW73πU")BNDkSmG+fIk,,Xn9O:K-xdCCqokA*Iqesj+:33]Y9hcZtvXZ;9tsDu%m0rUwPUπU"F?7qH8/<BQ+H5q)DPD9k=U?E4Uml4]\u9chHE;BMeDF7;7\6TPAm%#a5<G6</Q7πU"g3Wxc<(^Q:A;cMNjcsL:mSseC>+Z$zustLfFgpq0.?n]7amXdRIB80gJqSDxM9*πU"QT:uv<It,1tUUI(Jv&feqD&K(LaT2FoYST2JgY3T^mbTkcTOg<Iqw>'[Z75]_&:πU"jo%.b1vNy.dqN<iItYOx=iTry#4m)q6<\eO#<Xo:(KsP:82nh=UbE<n^Brl<RE$πU"9vr<+hNQ_?/Z\]Ak/i#GFiL'Rfin%8QMJ>ZHdbHKZ3lE0A[UZjQjhj$^U41/3D2πU"z+,TXc/?nb)\4&qX6O[_V4o>iq8hIuw=;ap'0bKiRSs],s;w^O4mg^P/_AhL/5YπU"/\e4vI#sIUW=N5-cbYJDua*+5n^<X<fSJ*m3<=f89?jx4;hxV10DUyZ1_Oq82/rπU"CNU5^smDu[3AoK^z+b2EgT#t#SW4%bh^&aBx3FV%*h786_\d6NT<e2Y+C].ICu%πU"+D>&XX=Q'TnVlH0ZMTFwbA=pj'O1'+?;0x^hEKM4[CU^uJS5X>CZ03DmR_=DjBjπU"+d-pr.*K_tjAg3&:4SJW$P+Au/],)G.,QAvUN(_BQ_?EYp$I.ck--^*-^.Kf*KsπU"&ZQU#mNGr+dXx^4fke_?E1_Q*X\OF=78:'eT$I=9j'DJ\2PfXQIH0&gsWV?0+<XπU"_0jke./G2BXGGPFG#JvSIK+q'L#c386.:8^XT0=Qpg8S]tY$hYxgidK<nJ(Sp**πU"gSzJ7J)LIF(RBTNWIA.VGn3r\bv0<SH%JT8y+3AcjQtqW'9A%6a.w=Rcx&S[)wHπU"N\1[9iBt,]F2teNi-GqJ-Xf]Dg<.B.-^x%u%p()9%%%%-(%Ll/aF:Yv*-^&%+%=πU")%%%-%%%%xuf%hjSg(ndyv,:,U98LTmdNUV=B6+:)=eC4J)mK_:?MastJ2C<)'IπU"zpu2<tMv<Qd%$tk[rGGQ2pmB.H<0d]oM+/&k&PyDXs'V/$OJ8aOR*kXEW:2.56]πU"hLq>VR0/E'7&nl.&sOK&'K3+VqVW]gOO+uDPIl[<oVS/#CaH-_iCPti-[GJd=%TπU"XgvGicP?gSw)\XLRt4*Vy]y/hE8KskY%-2Lz,Ro%\I-R>3c'O_gmN4B>I]YOhH*πU"F#g$G25VL$A[SY(_'0;R>jQZE0og5T?)<14h2QoGbMW&[J-Lu\Di#?$L5+g[k\NπU"?Wf\1YDiEKD<:x)S.OKxlW.]Fp6r'M=Wh_vx>OWhH=MVn:uOd$FuXDwg0#aV?)]πU"LuPciRb*JhfZ^]4LlHg5O6G9\:9jrN'?=:5H,UcM^su:cK?N*ddBOgc0h0GSfGcπU".GY?+0XA_b6JBkm0Hkq%?u\3'?23%4E'kwnr]BAwQ#oJ[4Yp7-o4R_y7l3iMU('πU"P<X0%6aY83b$d%up&'%9%9%%%%-%%oC1FYzCib'13%%%#R%%%.%%%%%%%%%&%E%πU"%%%%%%%%xu%fhjS%gfxu%p&'9%%9%%#%-%L[l/F:XYv-^[&%%=%)%%-%%%%%%%%πU"%&%%E%%+%X3%%%xuf%hjSg%nup*%+%%%%%'%'(%<%%(%c5%%%%%πEND SUBπCLOSE:IF S=137AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπPeter Norton FIND AVAILABLE BYTES ON DRIVE Advanced BASIC Book 1990 QB, PDS 37 936 DISKFREE.BASDECLARE FUNCTION DiskFree& (Drive$)ππTYPE RegTypeπ ax AS INTEGERπ bx AS INTEGERπ cx AS INTEGERπ dx AS INTEGERπ bp AS INTEGERπ si AS INTEGERπ di AS INTEGERπ flags AS INTEGERπEND TYPEππDECLARE SUB INTERRUPT (IntNo AS INTEGER, InRegs AS RegType, Outregs AS RegType)ππ CLSπ PRINT "The number of bytes free on drive C are: ", DiskFree&("C");π PRINT "The number of bytes free on drive A are: ", DiskFree&("A");ππENDππFUNCTION DiskFree& (Drive$)ππ DIM InRegs AS RegType, Outregs AS RegTypeππ DiskFree& = -1π IF LEN(Drive$) <> 1 THEN EXIT FUNCTIONππ InRegs.ax = &H3600π InRegs.dx = ASC(UCASE$(Drive$)) - ASC("A") + 1π CALL INTERRUPT(&H21, InRegs, Outregs)π IF Outregs.ax = -1 THEN EXIT FUNCTIONππ Temp& = Outregs.axπ DiskFree& = Temp& * Outregs.bx * Outregs.cxππEND FUNCTIONπEdward Blake BATCH PROCEDURES eblake2@quebectel.com 07-04-96 (19:54) QB, PDS 154 5053 BATCH.BAS ' 1996 Edward Blake (still 14 years old) Quebec, Canadaπ' Routines called from a Batch (.BAT) file. can be used for making a simpleπ' Installation batch program or anything else.π' uses the StrTok routine from the quickbasic example program Token.basπ' for tokenizing the command$π' Can't be used with QBasic because QBasic doesnt support Command$π'π' $INCLUDE: 'QB.BI'πDECLARE SUB READER (FILE$)πDECLARE SUB BCKGND ()πDECLARE SUB WIN (X1!, Y1!, X2!, Y2!, A$)πDECLARE FUNCTION StrTok$ (Source$, Delimiters$)πDECLARE SUB EXITWITHERRLEVEL ALIAS "_EXIT" (N AS INTEGER)πDIM TOK$(10)πIF COMMAND$ <> "" THENπP$ = COMMAND$πDELM$ = " ,;:()?" + CHR$(9) + CHR$(34)πTOKN$ = StrTok$(P$, DELM$)πWHILE TOKN$ <> ""π TOK$(I) = TOKN$π I = I + 1π TOKN$ = StrTok$("", DELM$)πWENDπFOR I = 0 TO 10πTOK$(0) = UCASE$(LTRIM$(RTRIM$(TOK$(0))))πNEXT IπSELECT CASE TOK$(0)πCASE "BCKGND"πBCKGNDπCASE "COLOR"πCOLOR VAL(TOK$(1)), VAL(TOK$(2))πLOCATE 1, 1: PRINTπCASE "WIN"πWIN VAL(TOK$(1)), VAL(TOK$(2)), VAL(TOK$(3)), VAL(TOK$(4)), TOK$(5)πCASE "PROGRESS"πLOCATE VAL(TOK$(1)), VAL(TOK$(2)): PRINT STRING$(VAL(TOK$(3)) / 10, 219)πCASE "LOCATE"πLOCATE VAL(TOK$(1)), VAL(TOK$(2))πCASE "SELECTDRIVE"πWIN 20, 5, 40, 11, "Select Drive"πDOπI$ = INKEY$πIF I$ = CHR$(0) + CHR$(80) THEN Y% = Y% + 1πIF I$ = CHR$(0) + CHR$(72) THEN Y% = Y% - 1πIF I$ = CHR$(13) THEN EXIT DOπIF Y% = 0 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 6, 21: PRINT " A: "πIF Y% = 1 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 7, 21: PRINT " B: "πIF Y% = 2 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 8, 21: PRINT " C: "πIF Y% = 3 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 9, 21: PRINT " D: "πIF Y% = 4 THEN COLOR 15, 1 ELSE COLOR 7, 0πLOCATE 10, 21: PRINT " E: "πLOOPπEXITWITHERRLEVEL Y%πCASE "READER"πREADER TOK$(1)πEND SELECTπELSEπPRINT "▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";πPRINT "▒▒╒══════════════════════════════════════════════════════════════════════════╕▒▒";πPRINT "▒▒│ Batch Procedures - 1996 Edward Blake │▒▒";πPRINT "▒▒├──────────────────────────────[Commands]──────────────────────────────────┤▒▒";πPRINT "▒▒│Win x1 y1 x2 y2 title (note: no parameters are optional except title) │▒▒";πPRINT "▒▒│bckgnd (note: all parameters are ignored) │▒▒";πPRINT "▒▒│color num1 [num2] (note: default is 0 for all parameters!!) │▒▒";πPRINT "▒▒│Progress x1 y1 value │▒▒";πPRINT "▒▒│selectdrive (note: will return a errorlevel 0=A 1=B 2=C 3=D 4=E,only A-E) │▒▒";πPRINT "▒▒│locate x1 y1 (use echo for displaying text) │▒▒";πPRINT "▒▒│Reader filename (must have the extension) │▒▒";πPRINT "▒▒╘══════════════════════════════════════════════════════════════════════════╛▒▒";πPRINT "▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒";πEND IFππSUB BCKGNDπFOR I = 1 TO 24πLOCATE I, 1: PRINT STRING$(80, 177);πNEXT IπLOCATE 25, 1: PRINT STRING$(80, 177);πEND SUBππSUB READER (FILE$)πDIM FILEC$(500)πOPEN FILE$ FOR INPUT AS #1πDO UNTIL EOF(1)πINPUT #1, FILEC$(I)πI = I + 1πLOOPπCLOSE #1πCOLOR 7, 1πY = -1πDOπI$ = INKEY$πIF I$ = CHR$(0) + CHR$(80) THEN Y = Y + 1πIF I$ = CHR$(0) + CHR$(72) THEN Y = Y - 1πIF I$ = CHR$(27) THEN EXIT DOπIF Y < -1 THEN Y = -1πIF Y > 474 THEN Y = 474πFOR I = 1 TO 25πLOCATE I, 1, 0: PRINT FILEC$(I + Y) + STRING$(80 - (LEN(FILEC$(I + Y))), 32);πNEXT IπLOOPπCOLOR 7, 0πCLSπEND SUBππFUNCTION StrTok$ (Srce$, Delim$)πSTATIC Start%, SaveStr$ππ ' If first call, make a copy of the string.π IF Srce$ <> "" THENπ Start% = 1: SaveStr$ = Srce$π END IFππ BegPos% = Start%: Ln% = LEN(SaveStr$)π ' Look for start of a token (character that isn't delimiter).π WHILE BegPos% <= Ln% AND INSTR(Delim$, MID$(SaveStr$, BegPos%, 1)) <> 0π BegPos% = BegPos% + 1π WENDπ ' Test for token start found.π IF BegPos% > Ln% THENπ StrTok$ = "": EXIT FUNCTIONπ END IFπ ' Find the end of the token.π EndPos% = BegPos%π WHILE EndPos% <= Ln% AND INSTR(Delim$, MID$(SaveStr$, EndPos%, 1)) = 0π EndPos% = EndPos% + 1π WENDπ StrTok$ = MID$(SaveStr$, BegPos%, EndPos% - BegPos%)π ' Set starting point for search for next token.π Start% = EndPos%ππEND FUNCTIONππSUB WIN (X1, Y1, X2, Y2, A$)πFOR I = Y1 TO Y2πLOCATE I, X1: PRINT STRING$(X2 - X1, 32);πNEXT IπLOCATE Y1, X1 + 1: PRINT STRING$(X2 - X1 - 1, 196);πLOCATE Y2, X1 + 1: PRINT STRING$(X2 - X1 - 1, 196);πFOR I = Y1 + 1 TO Y2 - 1πLOCATE I, X1: PRINT CHR$(179);πLOCATE I, X2: PRINT CHR$(179);πNEXT IπLOCATE Y1, X1: PRINT CHR$(218);πLOCATE Y1, X2: PRINT CHR$(191);πLOCATE Y2, X1: PRINT CHR$(192);πLOCATE Y2, X2: PRINT CHR$(217);πIF A$ <> "" THENπLOCATE Y1, ((X2 + X1) / 2) - ((LEN(A$) + 2) / 2): PRINT " " + A$ + " "πEND IFπEND SUBπJoe Negron FILE HANDLES FidoNet QUIK_BAS Echo 07-15-96 (21:44) QB, PDS 56 1745 HANDLES.BAS '> In the CONFIG.SYS file, put the line FILES=20, or howeverπ'> many you need and your version of DOS will tolerate.ππ'No, it's not quite that simple. The FILES directive in CONFIG.SYSπ'specifies the maximum number of file handles the *system* (not program)π'will allow. But, that does not mean that a particular program will beπ'able to open that many files simultaneously.ππ'The .EXE's PSP has a 20 byte file handle table (which leaves only 15 forπ'your program since DOS uses 5 file handles). The FUNCTION below,π'SetMaxFiles%(), calls a DOS interrupt which points the file handle tableπ'pointer to a larger area of memory.ππ'SETMEM() is needed because, by default, BASIC grabs all availableπ'memory. Passing SETMEM() a negative value tells BASIC to give up thatπ'much memory (in this case, 384 bytes is enough for at least 100 fileπ'handles).ππDEFINT A-Zππ'$INCLUDE: 'qb.bi'ππDECLARE FUNCTION SetMaxFiles% (NumFiles%)ππX% = SetMaxFiles% (100)ππFOR I% = 1 TO 100π Num$ = MID$(STR$(I%), 2)π OPEN STRING$(8 - LEN(Num$), "0") + Num$ + ".dat" FOR OUTPUT AS #I%πNEXT I%ππCLOSEπENDππ'***********************************************************************π'* FUNCTION SetMaxFiles%π'*π'* PURPOSEπ'* Uses DOS ISR 21H, Function 67H (Set Maximum Handle Count) to setπ'* the maximum number of handles.π'***********************************************************************πFUNCTION SetMaxFiles% (NumFiles%) STATICπ DIM Regs AS RegTypeππ X& = SETMEM(-384)π Regs.ax = &H6700π Regs.bx = NumFiles%ππ Interrupt &H21, Regs, Regsππ IF (Regs.flags AND 1) = 1 THENπ SetMaxFiles% = Regs.ax 'Error numberπ ELSEπ SetMaxFiles% = 0π END IFπEND FUNCTIONπRonald Kas READING FILES FROM DIRECTORY FidoNet QUIK_BAS Echo 08-16-96 (20:11) QB, QBasic, PDS 76 2533 READFILE.BAS' > Does anyone know how to get the list(s) of files in a certianπ' > driectory?? Without using the shell "dir" command?? can you use theπ' > bois absolute disk read to read the fat table?? I know there areπ' > simpler ways to do this, but I am wondering how the DIR command doesπ' > it... Such as to write my own, with out ANY shelling....ππ' It is not so easy, but it can surely be done.π' You have to use an Interrupt to get the DTA of a file.π' Here is an exemple (I don't know if it works in QuickBasic, but I knowπ' it works in Qbasic. So if it doesn't work in QuickBasic, try it inπ' Qbasic.)ππDECLARE SUB ReadFiles (pad$, masker$, Bestanden$(), BestLengte&(), BestAantal%)πDECLARE SUB ReadData ()πDECLARE FUNCTION Interr% (num%, AX%, BX%, CX%, DX%)πDIM Bestanden$(200), BestLengte&(200)πDIM SHARED MS%(30)πCLSπReadDataπReadFiles "", "*.*", Bestanden$(), BestLengte&(), BestAantal%πPRINTπPRINT BestAantal%; "Bestandengevonden"ππFOR i = 1 TO BestAantal%π PRINT Bestanden$(i), BestLengte&(i)π PRINT ,πNEXT iπPRINTππMS.Data:π DATA 55,8b,ec,56,57π DATA 8b,76,06,8b,14π DATA 8b,76,08,8b,0cπ DATA 8b,76,0a,8b,1cπ DATA 8b,76,0c,8b,04π DATA cd,21π DATA 8b,76,0c,89,04π DATA 5f,5e,5dπ DATA ca,08,00π DATA #ππFUNCTION Interr% (num%, AX%, BX%, CX%, DX%)π IF MS%(0) = 0 THEN PRINT "FOUT": ENDπ DEF SEG = VARSEG(MS%(0))π POKE VARPTR(MS%(0)) + 26, num%ππ CALL ABSOLUTE(AX%, BX%, CX%, DX%, VARPTR(MS%(0)))π Interr% = AX%πEND FUNCTIONππSUB ReadDataπ RESTORE MS.Dataπ DEF SEG = VARSEG(MS%(0))π FOR i = 0 TO 99π READ byt$π IF byt$ = "#" THEN EXIT FORπ POKE VARPTR(MS%(0)) + i, VAL("&H" + byt$)π NEXT iπEND SUBππSUB ReadFiles (pad$, masker$, Bestanden$(), BestLengte&(), BestAantal%)π DTA$ = STRING$(80, " ")π AX% = Interr%(&H21, &H1A00, 0, 0, SADD(DTA$))π BestAantal% = 0π FileName$ = pad$ + masker$ + CHR$(0)π AX% = Interr%(&H21, &H4E00, 0, 32, SADD(FileName$))ππ WHILE AX% < 18π f$ = MID$(DTA$, 31, 12)π IF INSTR(f$, CHR$(0)) THEN f$ = LEFT$(f$, INSTR(f$, CHR$(0)) - 1)π BestAantal% = BestAantal% + 1π Bestanden$(BestAantal%) = f$π BestLengte&(BestAantal%) = CVL(MID$(DTA$, 27, 4))π AX% = Interr%(&H21, &H4F00, 0, 0, 0)π WENDπEND SUBπSteven Anthony Morisi ETCH-A-SKETCH steve179@ix.netcom.com 05/96 (00:00) QB, QBasic, PDS 194 3577 ETCH.BAS DECLARE SUB instructions ()πDECLARE SUB pause ()πDECLARE SUB errtone ()πDECLARE SUB drawetch ()πDECLARE SUB quake ()π'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''π' Program : Etch Etch Date : 5/96π' Author : Steve Morisiπ' Comments : Not much to the program but my son & daughter ( 8 & 12)π' thought it was cute. Also I did use 2 snippets from theπ' ABC packets.π' My son Paul Anthony thought of incorporating the QUAKEπ' as a sub routine. π' Credit for the Quake code goes to William Yu. It was in oneπ' of the ABC packets in the Graphic section under the name ofπ' EARTHQUAKE EFFECT DEMO.π'π' Another snippet I used was ENDS.BAS written by RATBOYπ' If you invoke the code by QBASIC /RUN ETCHπ' then when you end the program you'll back out to theπ' prompt rather than the QBASIC editor.π'π' I'd appreciate any comments/suggestions atπ' STEVE179@IX.NETCOM.COMπ'π' Thanksπ'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''π'etch a sketch emulatorπDIM box%(1 TO 30000)ππSCREEN 9πx = 280πy = 175ππ'Assign names to colorsπblue = 1πgreenB = 2πcyan = 3πred = 4πmagenta = 5πrust = 6πwhite = 7πgrey = 8πblueB = 9πgreen = 10πcyanB = 11πorange = 12πmagentaB = 13πyellow = 14πwhiteB = 15ππ'Set up keysπKEY(2) ON 'F2πKEY(11) ON 'Up arrowπKEY(12) ON 'LeftπKEY(13) ON 'RightπKEY(14) ON 'Downπinstructionsπdrawetch ' initialize drawing areaππ'Drawing routineπDO WHILE (key.Press$ <> CHR$(27))ππ PSET (x, y), 0π key.Press$ = INKEY$ππ ON KEY(2) GOSUB newscreenπ ON KEY(11) GOSUB arrow.upπ ON KEY(12) GOSUB arrow.leftπ ON KEY(13) GOSUB arrow.rightπ ON KEY(14) GOSUB arrow.downππLOOPπCLSπSYSTEMπREM CHAIN "menu"πENDππarrow.up:πIF y < 76 THENπ errtoneπ RETURNπEND IFπy = y - 1π πRETURNππarrow.left:πIF x < 121 THENπ errtoneπ RETURNπEND IFπx = x - 1πRETURNππarrow.right:πIF x > 439 THENπ errtoneπ RETURNπEND IFπx = x + 1πRETURNππarrow.down:πIF y > 274 THENπ errtoneπ RETURNπEND IFπy = y + 1πRETURNππnewscreen:π quakeπ CLS 0π drawetchπ x = 280π y = 175πRETURNππSUB drawetchπerrtoneπ'colorsπblue = 1πgreenB = 2πcyan = 3πred = 4πmagenta = 5πrust = 6πwhite = 7πgrey = 8πblueB = 9πgreen = 10πcyanB = 11πorange = 12πmagentaB = 13πyellow = 14πwhiteB = 15πππ'draw etch sketchπLINE (120, 75)-(440, 275), blueB, BπLINE (70, 30)-(500, 330), blueB, BπPAINT (1, 1), cyan, blueBπPAINT (71, 31), red, blueBπPAINT (121, 76), grey, blueBπCIRCLE (145, 300), 20, blueBπCIRCLE (410, 300), 20, blueBπPAINT (400, 300), white, blueBπPAINT (150, 300), white, blueBππ'textπLOCATE 2, 26πPRINT " F2=CLEAR ESC=QUIT "πLOCATE 22, 22πPRINT " Etch Etch by MorisiWare "πLOCATE 23, 22πPRINT " Copyright 1996 "ππEND SUBππSUB errtoneπSOUND 450, 2πSOUND 500, 4πSOUND 450, 2ππEND SUBππSUB instructionsπSCREEN 9πCLSπFOR i = 50 TO 90 STEP 5πLINE (125, 1 + i)-(500, 250 - i), 3, Bπ'LINE (125, 1 + i + 1)-(500, 5 + i), 4, BπFOR delay% = 1 TO 15000: NEXT delay%πNEXT iπLOCATE 9, 18πPRINT " Draw by using Arrow keys on the Number Pad "πLOCATE 11, 18πPRINT " Press Enter "πpauseπEND SUBππSUB pauseπDO UNTIL INKEY$ <> ""πLOOPπEND SUBππSUB quakeπdelay = 5500πFOR x = 1 TO delayπOUT &H3D4, 8: OUT &H3D5, xπNEXT xππEND SUBπKurt Kuzba WRITING PIXELS IN MODE 12H FidoNet QUIK_BAS Echo 06-22-96 (00:00) QB, QBasic, PDS 48 2029 PUTPIX12.BAS' I also worked out a pixel location algorithm for 4-planeπ'graphics memory and designed a mode 12h putpixel with it.π'Notice that there is a four-step process in the pix12 routineπ'which could be served by a FOR/NEXT loop. Unrolling such loopsπ'is a standard method of speed optimization.ππ'_|_|_| PUTPIX12.BASπ'_|_|_| An example of writing pixels in video mode 12h.π'_|_|_| No warrantees or guarantees are given or implied.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (6/22/96)πDEFINT A-ZπDECLARE SUB pix12 (vertical%, horizontal%, c%)πDIM SHARED bitfield(7) AS INTEGERπ bitfield(0) = 128: bitfield(1) = 64: bitfield(2) = 32π bitfield(3) = 16: bitfield(4) = 8: bitfield(5) = 4π bitfield(6) = 2: bitfield(7) = 1πSCREEN 12πFOR y = 0 TO 639: pix12 y / 1.3, y, 5: NEXTπFOR y = 0 TO 639: pix12 479 - (y / 1.3), y, 14: NEXTπFOR y = 0 TO 639: pix12 y / 1.3, y, 14: NEXTπFOR y = 0 TO 639: pix12 479 - (y / 1.3), y, 5: NEXTπFOR c = 15 TO 0 STEP -1π FOR y = 308 - 5 * c TO 316 + 5 * cπ FOR x = 234 - 5 * c TO 242 + 5 * cπ pix12 x, y, c: IF INKEY$ <> "" THEN SCREEN 0: ENDπ NEXTπ NEXTπNEXT: WHILE INKEY$ = "": WEND: SCREEN 0πSUB pix12 (vertical%, horizontal%, c%)π IF (vertical% < 0) OR (horizontal% < 0) THEN EXIT SUBπ IF (vertical% > 479) OR (horizontal% > 639) THEN EXIT SUBπ DEF SEG = &HA000: OUT &H3CE, 4: OUT &H3C4, 2π P& = vertical%: P& = P& * 80 + horizontal% \ 8π bit% = bitfield(horizontal% AND 7): bitmask% = 255 - bit%π OUT &H3CF, 0: OUT &H3C5, 1: B% = PEEK(P&) AND bitmask%π IF (c% AND 1) <> 0 THEN B% = B% OR bit%π POKE P&, B%π OUT &H3CF, 1: OUT &H3C5, 2: B% = PEEK(P&) AND bitmask%π IF (c% AND 2) <> 0 THEN B% = B% OR bit%π POKE P&, B%π OUT &H3CF, 2: OUT &H3C5, 4: B% = PEEK(P&) AND bitmask%π IF (c% AND 4) <> 0 THEN B% = B% OR bit%π POKE P&, B%π OUT &H3CF, 3: OUT &H3C5, 8: B% = PEEK(P&) AND bitmask%π IF (c% AND 8) <> 0 THEN B% = B% OR bit%π POKE P&, B%πEND SUBπ'_|_|_| end PUTPIX12.BASπTika Carr GUI PROGRAMMER'S LIBRARY V1.23 FidoNet QUIK_BAS Echo 08-09-96 (17:04) QB, PDS 259 6892 GUI123.BAS 'GUI123.BAS 8/9/96π'GUI Interface Programmer's Library v. 1.23π'for QuickBasic 4.5π'Copyright 1996 by Tika Carrππ'Contact:π'Tika Carr 1:2613/601π'kari@rochgte.fidonet.orgππDECLARE SUB clrscrn (clr%)πDECLARE SUB drwbtn (ds%, dc%, dfs%, dfc%, dx1%, dy1%, dx2%, dy2%)πDECLARE SUB gprint (z$, x%, y%, c%)πDECLARE SUB Mouse (a%)πDECLARE SUB PopInp (Prompt$, T2Len%, x1%, y1%, CurClr%)ππ'$INCLUDE: 'qb.bi'ππCOMMON SHARED mb%, mi%, mt%, mx%, my% 'mouse variablesπCOMMON SHARED black%, white% 'used for paletteπCOMMON SHARED T2$ 'PopInp resultsπDIM SHARED Inregs AS RegType, Outregs AS RegType 'InterruptπDIM SHARED Regs AS RegTypeX 'InterruptXππSCREEN 12: CLS '640 x 480 16 color VGA 80 x 30 textππ'** PALETTE ASSIGNMENT **ππ' Color 0 and Color 15 are system colors (black and white) and shouldπ' not be changed as they are used for buttons and such.ππblack% = 0: white% = 15ππDEFINT A-ZππWIDTH 80, 60ππ'Clear the screen to color #3 (Cyan)πCALL clrscrn(3)ππ'Change white to be 7, causing the boarder highlight to be greyπ'instead of white. Change the menu bar to be white, then draw menuπ'bar, and change white back to color #14 (white)ππwhite = 7πCALL drwbtn(2, 15, 0, 0, 0, 0, 639, 20)πwhite = 15ππ'The "Exit" box in the upper left.πCALL drwbtn(2, 7, 0, 0, 2, 2, 18, 18)πCALL gprint("X", 6, 4, 0)ππ'The "Help" box in the upper right.πCALL drwbtn(2, 7, 0, 0, 619, 2, 637, 18)πCALL gprint("?", 624, 4, 0)ππ'Menu OptionsπCALL gprint("File", 55, 3, 0)πCALL gprint("Edit", 107, 3, 0)ππ' A boxed frame text boxπCALL drwbtn(4, 9, 10, 1, 10, 30, 629, 459)ππ' Some text in the boxπa$(1) = "Here is an example of some things you can do in the GUI interface."πa$(2) = "I want to thank Douglas H. Lusher for his help in writing the gprint"πa$(3) = "routine. He developed a faster way to print text on the screen. This"πa$(4) = "routine does what the PRINT statement can't: Prints text virtually"πa$(5) = "anywhere on the screen, and transparently over the graphics."ππy = 34πFOR g = 1 TO 5π y = y + g + 16π CALL gprint(a$(g), 32, y, 14)πNEXT gππStart:π'Loop to trap mouse eventsπCALL Mouse(0) 'initialize mouseπCALL Mouse(1) 'show mouseππWHILE mb = 0 'trap eventsπ CALL Mouse(3)π LOCATE 60, 1π PRINT mx, my, mb;πWENDππ'The "Exit" box in the upper left clicked on.πIF mx > 2 AND my > 3 AND mx < 18 AND my < 18 THENπ CALL Mouse(2) 'hide mouseπ CALL drwbtn(1, 7, 0, 0, 2, 2, 18, 18)π CALL gprint("X", 6, 4, 0)π FOR delay = 1 TO 30000: NEXTπ CALL drwbtn(2, 7, 0, 0, 2, 2, 18, 18)π CALL gprint("X", 6, 4, 0)π CALL PopInp("Do You Really Want To Quit?", 1, 160, 120, 3)π IF LCASE$(T2$) = "n" THEN RUN ELSE ENDπEND IFππGOTO StartππSUB clrscrn (clr%)πLINE (0, 0)-(639, 479), clr%, BFπEND SUBππSUB drwbtn (ds, dc, dfs, dfc, dx1, dy1, dx2, dy2)πIF ds >= 3 AND ds <= 6 THEN c = dfc ELSE c = dcπSELECT CASE dsπ CASE 1: GOSUB dOnπ CASE 2: GOSUB dOffπ CASE 3: GOSUB dOn: GOSUB Inside: GOSUB dOffπ CASE 4: GOSUB dOff: GOSUB Inside: GOSUB dOnπ CASE 5: GOSUB dOn: GOSUB Inside: GOSUB dOnπ CASE 6: GOSUB dOff: GOSUB Inside: GOSUB dOffπ CASE 7: GOSUB Dsquπ CASE 8: GOSUB Dsqu: LINE (dx1, dy1)-(dx2, dy2), black%: LINE (dx1, dy2)-(dx2, dy1), black%π CASE 9: GOSUB Dcirπ CASE 10: GOSUB Dcir: CIRCLE (dx1, dy1), (15 - dfs) \ 2, dfc: PAINT (dx1, dy1), dfc, dfcπEND SELECTππGOTO DdoneππDsqu:π LINE (dx1, dy1)-(dx2, dy2), black%, Bπ PAINT (dx2 - 4, dy2 - 4), c, black%πRETURNππDBold:π GOSUB Dsquπ LINE (dx1 + 1, dy1 + 1)-(dx2 - 1, dy2 - 1), black%, BπRETURNππdOn:π GOSUB DBoldπ LINE (dx1 + 1, dy2 - 1)-(dx2 - 1, dy2 - 1), white%π LINE -(dx2 - 1, dy1 + 1), white%πRETURNππdOff:π GOSUB DBoldπ LINE (dx1 + 1, dy2 - 1)-(dx1 + 1, dy1 + 1), white%π LINE -(dx2 - 1, dy1 + 1), white%πRETURNππDcir:π CIRCLE (dx1, dy1), dfs, black%π PAINT (dx1, dy1), dc, black%πRETURNππInside:π dx1 = dx1 + dfs: dy1 = dy1 + dfsπ dx2 = dx2 - dfs: dy2 = dy2 - dfsπ c = dcπRETURNππDdone:πdx1 = dx1 - dfs: dy1 = dy1 - dfsπdx2 = dx2 + dfs: dy2 = dy2 + dfsππEND SUBππSUB gprint (z$, x%, y%, c%)πRegs.ax = &H1130πRegs.bx = &H600πCALL INTERRUPTX(&H10, Regs, Regs)πCharSegment% = Regs.es: CharOffset% = Regs.bpπCharWid% = 8: CharHgt% = 16ππDEF SEG = CharSegment%πXX% = xπFOR Char% = 1 TO LEN(z$)π Ptr% = CharHgt% * ASC(MID$(z$, Char%, 1)) + CharOffset%π FOR Ln% = 0 TO CharHgt% - 1π BitPattern& = PEEK(Ptr% + Ln%) * 256&π LineFormat% = (BitPattern& - 32768) XOR -32768π LINE (XX%, y + Ln%)-STEP(CharWid% - 1, 0), c, , LineFormat%π NEXTπ XX% = XX% + CharWid%πNEXTπDEF SEGπEND SUBππSUB Mouse (a%)πInregs.ax = a%πCALL INTERRUPT(&H33, Inregs, Outregs)πmb = Outregs.bx 'button 0 = off 1 = left 2 = rightπmx = Outregs.cx 'x coordinateπmy = Outregs.dx 'y coordinateπmi = Outregs.ax 'init (dummer variable)ππEND SUBππDEFSNG A-ZπSUB PopInp (Prompt$, T2Len%, x1%, y1%, CurClr%)ππIF LEN(Prompt$) > T2Len% THEN PBoxLen = LEN(Prompt$) ELSE PBoxLen = T2Len%πx2% = x1% + (PBoxLen + 2) * 8: y2% = y1% + 64: nx = x1%: ny = y1%ππCALL Mouse(2)πBitsPerPixel = 1: planes = 4 'Screen Mode 12πAry% = 4 + INT(((x2% - x1% + 1) * (BitsPerPixel) + 7) / 8) * planes * ((y2% - y1%) + 1)ππDIM VScreen(1 TO Ary%)πGET (x1%, y1%)-(x2%, y2%), VScreenππCALL drwbtn(2, 7, 0, 0, x1%, y1%, x2%, y2%)πx1% = x1% + 8πCALL gprint(Prompt$, x1%, y1% + 8, 0)ππInloop:πy1% = y1% + 32π'Input FieldπCALL gprint(">", x1%, y1%, 0)πCALL gprint(STRING$(T2Len%, 219), x1% + 8, y1%, 15)ππ'** Turn on and show cursorπx1% = x1% + 8πcursor$ = CHR$(219)πCALL gprint(cursor$, x1%, y1%, 4)ππ'** Get Input and move cursorππT2$ = ""π1 T1$ = INKEY$: IF T1$ = "" THEN 1 'wait for keypressπst = ASC(T1$)ππ'Backspace and eraseππIF st = 8 THENπ 'checks to make sure its in fieldπ x1% = x1% - 8: IF x1% < nx + 16 THEN x1% = nx + 16: GOTO 1π CALL gprint(cursor$, x1% + 8, y1%, 15)π CALL gprint(RIGHT$(T2$, 1), x1%, y1%, 0)π CALL gprint(cursor$, x1%, y1%, 4)π 'subtracts deleted character from stringπ IF LEN(T2$) >= 1 THEN T2$ = LEFT$(T2$, LEN(T2$) - 1)π GOTO 1πEND IFππIF T1$ = CHR$(13) THEN GOTO 2 'End of input when ENTER is pressed.ππIF st < 32 OR st > 127 THEN BEEP: GOTO 1 'check for illegal characterππT2$ = T2$ + T1$πCALL gprint(cursor$, x1%, y1%, 15)πCALL gprint(T1$, x1%, y1%, 0)πx1% = x1% + 8π'checks to make sure its in fieldπIF x1% > (nx + T2Len% * 8 + 8) THEN BEEP: GOTO 1πCALL gprint(cursor$, x1%, y1%, 4)ππ'Get more inputπGOTO 1ππ2 'Erase menu, restore what was underneathπPUT (nx, ny), VScreen, PSETπERASE VScreenπCALL Mouse(1)ππEND SUBπKris Reeves QUICK MAZE MAKER kc7hrh@seamac.wa.com 08-20-96 (15:44) QB, QBasic, PDS 179 11255 QMM.BAS 'Batch Installation instructions:π'You MUST have PKUNZIP in your path statement for the install batch program toπ'work. it would be best if you extract the zip file and the install batchπ'program into the C:\ directory. Otherwise, you will need to move the QMMPROπ'directory to your root directory after installation.ππ'Manual Installation instructions:π'Make a directory named "QMMPRO" on the root directory. move the zip file toπ'this directory. Unzip the ZIP file USING THE STORED PATHS (-d switch ifπ'you're using PKUNZIP).ππ'To Run QMazMakrPRO:π'>From the DOS prompt in the C:\QMMPRO directory, simply type: QMMPRO <ENTER>π'This program is made to run from DOS and quit back to dos, so if you haveπ'QBASIC, you don't have to fiddle around inQbasic with running and quitting.ππ'Notes:π'This is the first program I've ever completed and uploaded somewhere. I wouldπ'really appreciate comments on any aspect of the program, suggestions, etc.π'Please write me about the "Checking" feature explained in the .BAS file! I'mπ'a little confused as to whether or not i even need that! Also, I have littleπ'experience with saving files and doing so efficiently. Please tel me if youπ'know of a better way to save my files!ππ'You can e-mail me at KC7HRH@Seamac.WA.COM with comments, suggestions,π'questions, or problems.ππ'I plan on making installation improvements and some other stuff in the futureπ'if enough people like this program, including much more flexibleπ'installation, possibly taking out the "Checking" feature (explained in theπ'.BAS file) and compressing saved maze files.ππ'Thanks for trying out QMazMakrPRO!ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"QMM.ZIP",4^6:Z&=6937:?STRING$(50,177);πU"%up()%9%%%#%%wS%1F%%%%%%%%%%%%%%%+%%%%rf&)jxT%up()%/%%%I%%zU71FπU"XT%9LF%%%%F%%%%0%%%%hf%yfqt%lSrr%uEXE%2/ij%rtrf&)j2/%ijrt/.y&t%πU"2/ij.rt.X%2/up%()9%%'%-%(3Y1FB6kc[%>%%%%M%%%%/%%%%vrru%wtSh%klxπU"UmWzY^7wU-)A$5[g3mFB(..#QJ&P)%u%p()9%%'%-.%yY1CFq3N%Z.7%1%j3%%%πU"/%%%%vrr%uwtS[gfxfjaTATs]+h'fkdC1DxYYadBpEeN=26&D$8p4AXyiH9.^.TπU"N-S'+Lpsfs/1P.Z9lb,z*$&3?'Y*Efq,;HeLA&'dA')?L%h\S2sYX9kr$BPwQW.πU">LuanFfo&:IPX01mlO%sSK[H&*$^RIB6b0bUoH9ngg-R0)?K?<gH52$zXT+h#B%πU"(-b-XL-fluhVqoS;<S#;R$f8t?7;;ejxKl&OuegEJKL?:h+[Xs)iNlP6lx,5TdHπU"=+v%wA-p/#o)W$u5'S0igTJ*o[/OBO8g'T#60tOGc*;+8=Ur;pUq[0[VClgM&e[πU"4gQ]X-)l&j#7U$oz9NWAjFW%#+zE<Z70//Fx1xt5BGEMEuO34g1;Cu.s&8k(=mRπU"PrV02308Ev<M0<=699Spo<A;)BN=uK,.EP=u-S?^[P/Uj0g-ra2D=XQP_f]8tPfπU"W+us(A7<8?U#PcBjV-45D1_BoDl$w7sA]a;&5:$u36H7,C/SL8EL2s/VqrH)PwRπU"sY)L<X-9\rTFed:NP*l+'prmBjVr[$$FxesnsDjWBWpwB\w3E50aS8ZG)$%UFoYπU"2EOH&/68s3aaDJ7O-vQFXi#D5lR>)GF1'F-5%]mT-#bD^umUX?Osb^?ZU;AHItTπU"1Wue5'F=N4jqD1Ud2,?Hhga4d]\xT&VT?\uxS+EfI9x44XWDa]AKctC]FgAK7)[πU"aCkr*MLDuc0j$jG<-vL*_tK3Qst%XEVB79Tq8m:)fj*J,M8EJLuV+Y%^V7eTYOHπU"PEiY[/9L$G7-nDM%RN8S0JuI;G/cIHSs_\=ZoqiPWb1e&N*M\]4%V2IFUhP_NP.πU">S7xh;6uje5%U'Snf,tm\TT?4*Iy+h<-9<WAEXS?ih28R7-BC>)GZD=qeir#%yQπU"c?Ll2XaU</1=zR0vm<eaE^-E>,hkwB$rZzf&cf&X6WR8mDF]8Wi5R/8e1DD(W-_πU",?Y(Q7#(Tvgh&SP;MTqQASKH3s)6W7LXkBt&J*.wypr/yPW$fHzCfM*q;0kHL>cπU"bi?amV'<'u6\R2ZpW*9NJ>=65-0vd_j1S,6l864.juH)lienn4rV-XM-/0q(rmMπU"Xe*<T^U9:Y49G.40%DZ1aRTguI]G+LOyB*c4Z/z/*Jo<&&0X+v/#XF0u1O9MkJ[πU"cNgs9BCV;F7]B*^u:s#9D&3I+-e#wB9yy*^TyS=D9NLTSa?l(/f2(j47Rpb*n=oπU"V;+(=8^nB/.lf&gpOxII;n;^J&0_lCJkCF3/K^+aWUgp(I>>HEFu^Hp6ft%5W#\πU"w*z<P7c5A_N>T(&)yt7\e\+c/Ta8uIYUeLxUJ&:(3aTnc&wk_f):3=hb&JN7(nVπU"*kzy#L#['UT/E729xxJ$_utX3GQ+SK;6+c3/p'[S]wRTdI::;q$T]jZsH##Z_v:πU"$g[VRW0o0S(#Q(Zcqu6M855u5l(7P^r-Ji+Re2=;>&hOtFm0_%i](;1bP'=n70tπU"i&wdNK-haNN))+.hDYP6cN^uhRU$QBm.At)wbLZ-bL-uc'Hy;(3iowDzFQ,(IGIπU"8'%BadUjY8L<'cp90c/A^l,Oo;kd0N93-640<YM[qg.KBA%b3b[5.HTCuQlITs.πU"QId5S4iq=Lfb'rfk;wj_e#(*4n5<;_cE&YI[_C.4[s$HneVjIsbkj:l33^<BFDnπU"Ec=m?%;4LmSV6.RJ*W5b922'BQFZ^q]w63,0M6/RlrNrVOOk(j(qf-jFSTPATRbπU"RRU3n:PdOp,osU\+tTHtjVlDw?RHxxSJCN1:vD5tl/3>$+;V(M5sht1g$W$K3f.πU"p2\nSn(Fp[x-;LkM(qFb%>]?pUief5cx$L<RdQdYw),DhDQl6,lkd#Y1(fx3IFVπU"9[^\wuVLYx<5Y1ui]U750L5#:2E=D:1HUlIglj^cvT8NgLOZgeWl4>?(0F\idF\πU"ZG:Hh75:pdPS4Q52&mcDUxmPq6&ml<Wr6Ij>M1D%B'Vp,J+nq&m<sspjO^(L5eLπU"5?iMtWoTCBBqg.45WaCJS8w#wLaV2cLuYg_7ItcJJdLHX7+#tk_m+AqKRi/tq1rπU"Y91N7.mSoN_?4&&YCiOhyK'ECZ49IVFCJ+>REXlQ6yI%Nf&=M9d7N;d$&_zgxsRπU"IF'QTsXl'55hgX:X;.$MI+r8i#z4Af&(%mMRA0aM*m'mfhTG1pdXA4^C.7[Lo\[πU"Fbp#hi0q/mpsU-H\Q6YaJ=QRN[&2pF.r,ivX3B9a-r^ZOW#f3Y]r+=[2<hmI,>#πU"ioj,zrU,<39HN8=$lpY^[6Qst;2hCkV_GX=\;[E+y:p/_gkau/RJHp,>tf,ZOE_πU",VLCVqjW(*b)+HcgN.$N,^CQkbwSQnTnr;fKR+z1>g>vE^k]D*F\T]M,kNN$Pg9πU"W9/ybP,Ur[5ENE52o+hfh:WF[#Pl.Hc&J2oant+[2[e.fz;B$T+^'#k8;>End7MπU"e%p%85xP<K:z4ae(C4;camGf#Xo<8Nl2/^FB\vP%ha41d=Xe>31$5u0G5zvDASbπU"uO1.j&m(FOGpFJv/S$kUB54&K>>Z7$01:_8Ipc*<\-jRwC)d^A$YXFD2s+v26JdπU"1<jcSUOtcRWWF?gjo;q*-PXTJD1-r%LQW'[pyQ$[:muW.h\<E]DOfF8vr+kAcLgπU"-OkcjsA_$Pl:AFgEQP$G>.:#6U0WhJ]wS1um*d$?\\<3vq>LH\sLUJIZG$(LC*5πU"add*aD?;82cv0%c_,IL-R,3Ibj*I=Ci_3blWs;klMXtaf;U>D?=2Yl(u'\nV1gDπU"KErKO1x(RHwd7dtm#x5<J7gx1f_Y]i+uLWlP&z'pCDroheCa3$6TC+sef[RqG3qπU"fDB7#cUqXn&K&/ZAO:-p%Q_TXh4:SMm]TQ9I$V0)'=LY3$l_9Uwn^&wf'-2BobJπU"N=LatJ37u=xMDE^l7^4<MBUTnWprCOK_v.w_7>5VT*4'Ueu7*WOD\Pp6J0p#hVDπU"nlQJ?HKokk\YTqMgxBATYB<pA#)\k'H\[VN93VAht'Iui>8FdtD:MEd26PBVMSqπU"u^>ou$v;*PU,u88?xE49P_64wv\0MLyR#(Q3Z6%mgTawQMmI5jhEdECACCz'MV8πU"s9-SGQAHaN)a4RI63MG?Gm9Gt&jQPRBK19Iz3sq1=R4e;3YsdoS(5eMQRJsVZ2/πU"aR8k^V\7u[-=W)T,Iw2APE.%Y3l#<IHe;#R%5UW5YaixT#0Jj#VN/eIrWA<*AE\πU"g;.1K#P\l985ph4#2HgRa_+:]8DZ-d+vM[E<RfppHN#t60pK^Y%8O>P;M;Z0cdRπU"Pz7$i3;0pN$aHxYfdW8+)&igsE<78:.>f<zK$y3_osDUj*at4nScyeGo2k:?8i'πU"g9>X2U-13n1)]ngH)-M\&\Ip[);#[CaM:I'ZGYN5p&s/68+5pp>UBAR\Qfsx[YGπU"oI-U2Y$/L7>.m:jkisj$Yxsl*#^2$VT2<aanZV<*WAx]_GkN)/t5.OfA\I^<6D+πU"4UtF'xS;a/Bdyr24Cae6nj3B:EX-u<AHiv1G_<>^umf;774Aw,;_MN^un0;wVkAπU"qr5,EodQMPNn&9Hwq4F/vQ<;_m%/U?)WqtuIJka;Rs'jB%9*l(Iz+5T15Tg]7+LπU"^Q(E2Zo'5Xt<_T%;0orkh:'87KJ?uik>-U6T_#&0H-rk:q'=7JO__j>*.e2Pki&πU"2AVY5d'<,qR_(Kl[8*f)^ABl(TzQRPDR6j==xmL6,6IMYUFU.'uhaBop,XzLegTπU"vMO[KJbkl9oU3<K0(:oNpaOEgY&#M74'GMk-p_?[-HQ5=c?K7Z)eZi1f3?vLsrMπU"y:m2ED[TpGer>jPEV(0:K>.DfuMFY52i%c2ifkv,jN3H2%1/gG)DHL*H3>ArKRQπU"\]DZp_]Vhzt.F.iC7.aP*J?3/sEBO;g]+J6tCSU=>eqCzk\qZR_P6\MY<>x4mπU"Er<JS.)P0+EjgLbo].iT=T8u+A:c9%Q;untp41wH\it+lu(8w+E[(2$LcNgmbpbπU"8Ebq]lxNeeOwC$S=G[\\x;=XhiaGxM3%idH4(Fa3,8cJXBC#P$>AmhZHa7<\7\/πU"6ndxcH#yT8DUl17aJc-XXsS2jUxMSE9jP/:0H'^'EQnuH>$O<cYRZD<.cJcOBl9πU"<fmb>?^8E\<3U3&\Ja8FOVl^HP6r^\#JjaY#i\hmFum5B,E*m\HQ-XBUJdTg?O_πU"JHIOw2.TGR6q4Cbxbq(RbjeVK4\6HICNE^imEYid80xVa%B:\Z_Jt#cF$s:ML_rπU"6pGg-Gkhp/f&);[]Uq))8RO5p1-(n6<Vlleeu^Kh539%/C=092=b2^xbI.t7ej<πU"v(sk2-4NV=>8Nw9k:X#Xt'MiRZGcQAA&?xL?5fX=1p&8GA-^?>LiW0gB)\C(/j+πU"v-aiAuW?\gVO2pk#[?SfH7;fIMVbWAb-P4N_QS<'pSyLi0y=_mc^^n(Wbd<+pqVπU"c#Nrj]5NBx6624(w*eteBYyO.rY+l5Q9]XRmM,:t-O-+ls-2W*G>%wMGZCp_B,&πU"$/T(sm$xl;EUBfwtetJfF^9)2-NYn2SDT*_+Zzi(cB'CO=NZMTJ?heAZKo([kyNπU"2-WbON=</A2DBlp8mGu?&FaHb%PG8wAtGip<K'+lNG.l%;*3GSP^.npGS$P;bf5πU"M<M*euQi:cA20uX7bi[^?V1b%+fS]\BAB:gM_''<o3WA=Sy1qcH0NH<ka0j/Rr]πU"(G9U-lFq$\8SmgTTARH5wD^Y%[-GVVB0V$QUwYef\n8]>ORa'q:X6I_\^\R:pI'πU"zZ$\v5I6RXnb+oT8$DQ/b6RZ3n7Y+$;Y0kY&OhN86kUs=vX-N3F[1HPsJzlNV_qπU"qitM6'2pF_3FSPRCY:li[+OV<n6e&ql1<HWYzvc1i&LBI/7/Mg_+OD4HYxGk.gWπU"/qqPY7vn)9,Mt]L1,Z)fO*QlG02crKO/B)cbZrNEWAX.1jRPY.;m%%<eu:L2t%mπU"n-bq8U&L1f:4N1m%U[ThPrJKk8YV37PW%_P\5(vC5>6>RjrEW,[>+4r^.U0JLnuπU".66U+1'5g,bg5/=mY]9EiBymZ$PYckL;z=I;[4-b'H;?Q00(Z5A-);7/OUo;a:TπU"1#n'LcOy1bXR<2\XNcGJZl(=2Cp,4r9,eOOst:T$iM_KuVUt[jdg8d0_XE=4uT1πU"Wa5eE%a^[.T:JLVSmeEHT>FOLe:.LNJddKezmRjb6_6;LP6j:kHjJ<G1g)JWL?6πU"19AFE;#F;cSWK*&k(B-^6Be(^ToiH&q-RRu2bGup*3mt+$G[itBwtxJj7x2tKxfπU"x>2kd'K_EXFQ:&U1'rEjQh+B/)7&1)>Q&t)/T\6NOd(q0yQPj^&Wj5*[*5?jI$iπU"FwKWK)s=:Nn[pl#07?EGqclv,m*Ua$t%pb%bqn=d7D2o44^2qU]r.c1maA;B6W7πU"a*6Y^$+=rt[4kb-Q]0,ok(#H\LE$xmpa/SS8AL<rEM''U^GGF'D8G[8hrZtn0f%πU"p$RM'l1zSA6x6-B$fv=P49X3B;F&i03P2h3SLp2UnIVn_i=eBGT;[e<rGwTruQeπU"$=#6]anK/d2>$([2h?Z_s*J1/l0k$=?L-P/r%(Gu7pXgw[2G9dLmd=T5c7W]PQ?πU"E9N*^^uDE)AS8+7?n8tn\]Ghir$X510c[x;XB)YhYj1zQ1[IZVjcH1:+&&/J<+#πU"vjdqfN89jdVf^eTKqeV(q_fmrPN2BS=&x$;]ar4Fe%#0;eq)a#QVc+0d0[6Zit.πU"1oP6i:J)DYZ,Od#)9'UP]FIwP<YlqMNdRB7\_2Rx2tzKJv>b'p)^fmX<Um%eTW$πU"\Z.cWnPqnQ.]at,\]dlX(o^NVRL\=N0J<i(<gQrwgqqrNS8k9WmtFQ6/[bIi5jBπU"_ihawt$Em;qahk0cK#d+Dc-qeMaqFNSsD6g]mHjhHwAPI)0Hjp<,Uw4%up()%9%πU"'%#-%L4[1FVa3ok5&7%%3*%%%7%%%%rf&)jxT%ijrt.rf)j%SrruS,yD$\2V-5-πU"4C^]2Thibmq%qAaAseubp%DINII4*^7.ZIukdtXQdrGLNv-:lkBvJ8CTDOMIc0mπU"^G_(oE2XzIcb%JLDTqV:^^AMB6&40T,gt6zFsXG5v5Al_)2LWAb4BDpX1>5R8;&πU"jG_$ErWJ?<>*h(Ls5:\QROnEJ=<WEu<+2,B/t[6^MU.%p(S:>4/E\Ox/f?\%kq8πU"*cO7csK#U^JR/u2oj+Xi=ULUagfPB+ICHZqK'tL##kzPLGan'1ing5<n(M$QX5:πU"egT/q7?Jdf)1]DFh4h0M2;>l]%XELh1]dE,ppXJ0Pr0-jaCV\liS(6b8y7hDT5MπU"qR8UO9.StYxYBtjcFP[pn0g=dsLz4i8:lUU31iSlFFuhJ8Mfs:V-5.\2_-;1l7LπU"]XD/IY%a_'hL8Z.;XtC<i>g[/ZjGaHm?'v%NLN<=;<sM]4#zd;Ic+<iK'x,up%(πU")9%%'%-%)aS1FLsxl7&9&%%'3*%%%7%%%.rf)j%xTij.rt.y&&tSr.ru4y:f=<UπU"a14,AODsS=K93JO,J]3acavtRh3XaU;px\M#;rwALCn.^NtIKK9t=lb6w5-CrWPπU"$XoYdL.f%'Dl8?agnY+eTLe0T1'dlKHM]xPh)DB1m'5iYL3OJh4\&w,P%+L45IMπU"W1[o.+fUW)IaJLif1RdY9_MKp%21m/=9AMnT$3b4VqOnQLr1)=$(Yv:MJfFtUOaπU"fHBTJJgb(oa2Sre1;\,5KAU(u-/>V$'/P^_0C):<egDAL-1m[Zu'xAIVBM:He%fπU"VwzArzTqS0IKsI6O3Zp/kZ6$*YD2V\TcJF1pICe/9(X]POn09+$,<B3Ii0rMX+JπU"do_#Z,.;Uv6RN0fJ(Dw,^1UkGJ)Mw_F[Ya%(L6RA/C'27diRy$ZONfErk#iR\$_πU"]*=cxTi>q*IR=[sEbnaC>QsTlF8*HfZ3<#V)=g)sdM7_k\UaC#L8DO2Hj8T[.NXπU"Y2(.%up()%9%'%I-%zU#1FPa*'qO(%%%U3%%%5%%%%rf&)jxT%ijrt&.XSrIru<πU"&:n]]U+14\u_NwLE/QC/C/ocA3=aavtZb+&T&A25y.ws1p[Ij^HOd8n^t^$H8utπU"p#suvnrsuvpn.X+O^BA\ccK^DKB$NCK\mW,lDBqrVp\u'pUk97c4L8',p#d;8)wπU"5ztLTZO^tGfE/^pD-fPY%-A6lF+_]29=nH6a\OpaLE#5YF*);V4An)aY2t5QC_vπU"Zj2S66fr4BEblGKQ%81+Oz11B.WkrV0\Viz<Vu]J*[<]7;-IW.;kP&=:<I/d6QmπU"ZJH8Z9jE,baj_QTEha7&+/i[$%e1>2tu569p3GI5+edHHXK1ieZstMb%-Nb[h,hπU"F79FBx#9'y[_HU\)Y6Jx7IBKSCduyx0_S;u_(GU+Q/04+?-W:(g-VBRaAn\fMuXπU"\M(0a^rV^6Ja.9iO+'u;'K]2t4m*5s>Yx##yD8qYgB=;27eh.Mq?hN0aPW84(MQπU"*)6?LS4(0M+T24$T=z'):R_pGS[0W(2ppPJhKCL+4:?\H#?t81l=\obg9oT$4e,πU"DXao52P?L#KDUqaYOKFG?sSp2dr/Gbrt.MI741P&>t.QmHgC:Le).xxu:K]qpTUπU"ClNw*G/I*j[9<p=/$m4LoUCDSiv#,W+kK$HIZ>F+jWT<#b>X6>rmM3%wJa.&W.6πU"[^=0[XbqEW3u4BW>c[B6^)xsn\:2kwo4zS-?kB\O%129jjU+Kn3NoGQ/3+A<<0CπU"8:w1Dt,0,EJukVYYl-Ko=%LU[UM\+qwfv+v3DyrUT[SD#o26PC*$O/pra*hK%EDπU"IL><_NbrD\&MU[SIHTeroHrN&q^9w[:(xmWC4%NfEizR?YWbW8tdFq.+:)v'pKbπU"qQ_wqY^51[_[rd)%k#%P_rJwkc--khyNar(\KFStVY1+K;$D:-#mbs/b4e_;lO9πU"$M)-pL-+JsE<J-)utsxQEa)$BfaMl-G3FX-EJUqd1'%T6oiqNrTAhCo8zgMP0v/πU"023[aD;6W[dtq%a0Q%4hw5;U//_,LKVb;A\PBuGu%gv5Ef,]eOjGJ03N;Faw1.^πU"QK(%up&'%9%9%%%%%%(wS1F%%%%%%%%%%%%%%%%+%%%%%%%%%&%U%%%%%%%%%rfπU"&)jxT%up&'%9%/%%%%%%)zU1F'XT9L%F%%%%F%%%%0%%%%%%%%%&%E%%%%I%%%%πU"hf%yfqt%lSrr%uup&%'9%9%%'%-.%3Y1+F6kc&[>%%%%M%%%%/%%%%%%%%%&%E#πU"%%%=%%%%v%rruw%tShk%lup&%'9%9%%'%-.%yY1CFq3N%Z.7%1%j3%%%/%%%%%%πU"%%%&%E[%%%(%%%%v%rruw%tSgf%xup&%'9%9%%'%-.%L41mFVao)k5&%+%3*%%%πU"7%%%%%%%%%&%E[%%%Y%7%%r(f)jx%Tijr#trf)%jSrr%uup&%'9%9%%'%-1%aS1πU"IFsxl)79&%+%3*%%%7%%%%%%%%%&%E#%%%E%9%%r(f)jx%TijrCt.y&%tSrr%uuπU"p&%'9%9%%'%-1%zU1dFPa'&qO(%%%U3%%%5%%%%%%%%%&%E%%%%5%;%%r(f)jx%πU"Tijr(t.XS%rruu%p*+%%%%%,#%,%j#&%%7%>%%%%%πEND SUBπCLOSE:IF S=37AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπDon Schullian/Jim Oliver DRAW A CADIOID (DAISY) d83@hol.gr 08-30-96 (10:20) QB, QBasic, PDS 156 6160 CARDIOID.BAS'Here's one for you that Jim and I got together on. It's kinda fun.π'Ok, this is it! No more beta versions of this thing! I'm DONE!π'Unless, of course, someone comes up with some improvements. :)ππ'The code below runs under Qbasic but is slower than growingπ'rocks so you may want to just draw one daisy and leave it at that.ππ'Those of you with PowerBASIC will want to add BYVAL andπ'LOCAL PUBLIC to the sub's declare line then tweek it all a bitπ'to get it back into fighting posture; if you decide to keep it.ππ'Anyhow, thanks for the great idea. I'm putting this one in theπ'box with my polygon routines for later. It may just come in handy.ππ'This, the final version will correctly draw Cadioid Curves (daisies)π' ** of any number from 1 up to ???π' ** uses the "ASPECT" variable like CIRCLEπ' ** will draw the curves at any degree of rotationππ'One of the demo's (RollingWheel) draws a wheel as it rolls up offπ'the screen. CanioidCurves is used to draw in the spokes and ASPECTπ'is imployed to provide perspective.ππ'The other demo routine, (Daisies) draws 20 daisies on the screen thenπ'rotates them clockwize until the next lobe/petal/loop comes up to theπ'12o'clock position.ππ'Both these are pretty crude and intended to show the use of the mainπ'routine. In short, Speilberg and Lucas can rest easy for a while yet.ππ'It may be worthy to mention here that this routine uses DEGREES ofπ'the circle and not RADIANS. I find it easier to work/think inπ'DEGREES so that's the way I made it.ππ'You will also want to play with the Aspect! variable. Try numbersπ'between .5 and 1.6 for some neat effects with screen 12 or .75 toπ'get round circles with SCREEN 9.ππ'Anyhow, this one goes into the PUBLIC DOMAIN so have at it!ππ'=================π' START TEST CODEπ'=================πSCREEN 12πRollingWheelπDaisiesππ'============================================================π'=== THIS CODE IS RELEASED INTO THE PUBLIC DOMAINπ'=== USE AT YOUR OWN RISK and all that legal rottπ'============================================================π' CONCEPT: Jim Oliver jim.oliver@welcom.net.nzπ'CODED BY: Don Schullian, DASoft Software, d83@hol.grπ'CODED IN: The code is pretty well generic but may requireπ' some small changes to run.π' PURPOSE: Draw a cadioid (daisy) to the graphics screen (12)π' PARAMS: Col% center column (pixel)π' Row% center row (pixel)π' Radius% radius in pixelsπ' Asp! aspect ratio 1 = normal for VGAπ' StartD! starting degree for "top" lobeπ' 0 is 12o'clock, 90 is 3o'clock, etcπ' Lobes% number of lobes/loops/petalsπ' Colour% color to draw inπ'============================================================πSUB CadioidCurves (Col%, Row%, Radius%, Asp!, StartD!, Lobes%, Colour%)ππ IF (Lobes% MOD 2) = 1 THEN ' an odd number of lobesπ Petals% = Lobes% 'π T% = 1 ' stop after 1st passπ ELSE ' even number of lobesπ IF (Lobes% MOD 4) = 0 THEN T% = 2 ' only 1 pass requiredπ Petals% = (Lobes% / 2) ' decrease # lobesπ END IF 'π Pi2! = (8 * ATN(1)) ' pi * 2π Srad! = StartD! - (90 \ Petals%) - 90 ' adjust to find topπ XRad! = Radius% ' horizontal radiusπ YRad! = Radius% ' vertical radiusπ IF Asp! > 1 THEN ' aspect = 1 for VGA is normalπ XRad! = Radius% / Asp! ' squish verticallyπ ELSEIF Asp! < 1 THEN 'π YRad! = Radius% * Asp! ' squish horizontallyπ END IF 'π 'π DO 'π IF T% = 1 THEN ' compute starting degreeπ Srad! = Srad! + (180 \ Petals%) 'π END IF 'π Sr! = Srad! * (Pi2! / 360) ' compute radians for degreesπ PSET (Col%, Row%), Colour% ' center dot - sets LPRπ FOR T! = .01 TO Pi2! STEP .01 ' start drawingπ L! = SIN(Petals% * T!) ' compute factors toπ P! = T! - Sr! ' use to compute X and Yπ R! = XRad! * L! ' general purpose radiusπ X% = Col% + (R! * COS(P!)) ' compute column for pixelπ IF Asp! <> 1 THEN R! = YRad! * L! ' if aspect other than normalπ Y% = Row% - (R! * SIN(P!)) ' compute row for pixelπ LINE -(X%, Y%), Colour% ' draw line from LPR to new XYπ NEXT 'π T% = T% + 1 ' increase pass counterπ LOOP UNTIL (T% > 1) ' all done!ππEND SUBππ' ------------------π' --- DEMO SUBS ---π' ------------------ππSUB Daisiesππ CLSπ Col% = 50π Row% = 50π Rad% = 50π Aspect! = 1!π Colour% = 14ππ FOR Lobes% = 20 TO 1 STEP -1π I% = (360 \ Lobes%)π FOR StartD! = 0 TO I%π CadioidCurves Col%, Row%, Rad%, Aspect!, StartD!, Lobes%, Colour%π IF StartD! = 0 AND C% > 0 THEN SLEEP .5π IF StartD! = I% THEN EXIT FORπ G$ = INKEY$: IF LEN(G$) > 0 THEN EXIT SUBπ LINE (Col% - Rad%, Row% - Rad%)-(Col% + Rad%, Row% + Rad%), 0, BFπ NEXTπ Col% = Col% + 110π IF Col% > 580 THENπ Row% = Row% + 110π Col% = 50π END IFπ NEXTπEND SUBππSUB RollingWheelππ CLSπ Row% = 400π Rad% = 40π Aspect! = 1.2π StartD! = 0π Lobes% = 11π Colour% = 15ππ Col% = Rad%π Sincr! = (360 \ Lobes%)π DOπ CIRCLE (Col%, Row%), Rad%, Colour%, , , Aspect!π CadioidCurves Col%, Row%, Rad%, Aspect!, StartD!, Lobes%, Colour%π G$ = INKEY$: IF LEN(G$) > 0 THEN EXIT SUBπ Col% = Col% + 1π Row% = Row% - 1π StartD! = StartD! - Sincr!π LINE (Col% - Rad% - 2, Row% - Rad% - 2)-(Col% + Rad% + 2, Row% + Rad% + 2), 0, BFπ LOOP UNTIL (Col% > 639) OR (Row% < Rad%)πEND SUBπScott Turchin GET BACK TO ROOT DIRECTORY nitehawk@tscnet.com 07-24-96 (11:26) QB, QBasic, PDS 15 476 GETBACK.BAS I once needed a simple but effective way to return to my programs root πdirectory each time I returned from a shell, rather than type it out πeach and every time (there are 4 shells in my program) I made this happy πlittle subroutine...However, Somewhere in the beginning of the program πthis must be performed:πHere$=CurdirπDrive$=LEFT$(CURDIR,1)πππSUB GETBACK( HERE$, DRIVE$ ) PUBLICπ CHDRIVE DRIVE$π CHDIR HERE$πEND SUBππVery Very simple, but effective...πGeorge Phillips FORMAT OF GRASP ANIMATION FILE phillips@cs.ubc.ca 03-15-91 (04:16) Text 816 29501 GLFORMAT.TXTNote that some of this information is incomplete. Check the Graspπmanual for clarification on e.g. the script-file commands. If πanybody would like to merge all relevant documents together, thatπwould be nice.ππThese documents were passed to me by Martin Fong, fong@erg.sri.comππEli Brandt eli@smectos.gang.umass.edu 32@4351 WWIVπ========================================================================ππThe formats of GRASP animation files.πBy George Phillips <phillips@cs.ubc.ca>πDistribute this freely, but give credit where credit is due, eh?πVersion: Jan. 19,1991ππGRASP is an animation system particular to the IBM PC world. It consistsπof a program to create animations and a run-time environment forπdisplaying them. The most common form these animations take is ".GL"πarchives which may be displayed on an IBM-PC with a program calledπGRASPRT.EXE. This document describes what I have been able toπdecipher about the format of ".GL" archives and the files containedπwithin. It should be useful to those attempting to write ".GL"πanimation players on other platforms.ππA ".GL" file is simply an archive file which contains images, fontsπand a command file which tells GRASPRT what to do. These variousπfiles have standard extensions to denote their contents:ππ.txt - A command file; usually there is only one of these per archive.π.pic - An image.π.clp - An image but without a colour map.π.set or .fnt - A font containing character glyphs.ππIt should be noted that the GL archive is of no particular importance;πall the archived files could exist as ordinary files and the animationπshould still work. Any GL player should be able to operate both fromπan archive or from ordinary files.πππFile FormatsππMost of the data in GL files can be adequately described as a streamπof bytes which is practically universally understood. Some fieldsπcontain 2-byte and 4-byte integers. I'll refer to these as "words"πand "long words" and they are all stored in little-endian format.πSo if we have 4 consecutive bytes, b1, b2, b3 and b4, the wordπat b1 is (b1 + b2 * 256) and the long word at b1 isπ(b1 + b2 * 256 + b3 * 256 * 256 + b4 * 256 * 256 * 256).ππSince this information was gathered by example, the purpose of someπheader fields and commands may not be known. I've marked unknownπfields with question marks and have tried to put question marks andπother warnings about descriptions which are guesses.πππGL Archives (.gl)ππA GL archive begins with a directory listing the files in the archiveπwhich is followed by the data for each file.ππ+-- Directory Headerπ| dir length (word) number of bytes in the directory headerπ| +-- File Entry (17 bytes per, (dir length) / 17 of them)π| | offset (long word) Position of file data as an offset fromπ| | the beginning of the archiveπ| | name (13 bytes) File name, null padded.π| +--π+--- File data areaπ| +-- File Dataπ| | length (long word) Size of the fileπ| | data (bytes) the file's data (surprise!)π| +--π+---ππFont Files (.fnt or .set)ππThese are very simple; first a short header describing the size of theπcharacters in the font and what byte values correspond to each glyphπfollowed by the glyph data.ππ+-- Font Headerπ| length (word) length of the entire font fileπ| size (byte) number of glyphs in the font fileπ| first (byte) byte value represented by the first glyphπ| width (byte) width of each glyph in pixelsπ| height (byte) height of each glyph in pixelsπ| glyphsize (byte) number of bytes to encode each glyphπ+-- Glyph Dataπ| glyph firstπ| glyph first + 1π| ...π| glyph first + size - 2π| glyph first + size - 1π+--ππEach glyph is stored almost exactly as you would expect a raw PBM file toπcontain it except that a '0' bit means black and a '1' bit means white.πIn other words, row major order, each line padded to end on a byteπboundary, most significant bit is leftmost.πππImage Formats (.pic and .clp)ππThese consist of a header containing the usual image information followedπby blocked, run-length encoded image data.ππ+-- Image Header (17 or 19 bytes)π| magic? (byte) magic number? Always is 0x34 or 0x12π| width (word) width of image in pixelsπ| height (word) heigh of image in pixelsπ| ???? (4 bytes) unknownπ| bpp (byte) bits per pixel (only seen 1 or 8)π| type (byte) image type, either 'L' or 'C'π| flags (byte) if (flags & 4) then image has colourmapπ| ? (byte) unknownπ| extend (byte) extended header byte (if != 0, headerπ| has 2 more bytes) 1/2?π| ? (byte) unknownπ| ?? (2 bytes) header extension if extend != 0π+-- Colour Map ((1 << bpp) * 3 bytes, only if flags & 4 == 4)π| +-- Colour Map entries (as many as indicated by bpp)π| | R (byte) red intensity, 0 - 63 \π| | G (byte) green intensity, 0 - 63 + entry 0π| | B (byte) blue intensity, 0 - 63 /π| +--π| ...π+-- Image Dataπ| blocks (word) number of blocks of dataπ| +-- Data Block (blocks of them)π| | length (word) length of data block, including headerπ| | bufsize (word) buffer size needed to hold all theπ| | uncompressed data in this blockπ| | esc (byte) the escape code in this blockπ| | data (length - 5 byte) run-length encoded dataπ| +--π+--ππThe run-length encoding is byte oriented and follows these rules:ππ- characters other than "esc" (see data block header) are literalπ- esc n c means repeat c n times (1 <= n <= 255)π- esc 0 len(word) c means repeat c len timesππIf bpp=1, then the resulting data stream is interpreted as it isπwith font glyphs (i.e., msb is left, pad to bytes, row first, etc).πIf bpp=8, then each byte in the data stream is an index into theπcolour map. If no colour map is available, the map to use canπonly be discovered by running through the command file.ππI've only seen images with bpp=1 and bpp=8 and they it always worksπout that either bpp=1 and type=C or bpp=8 and type=L. The type=Cπcorresponds to CGA graphics which are mostly monochrome and 640 x 200π(so the aspect ratio is funny). Type=L is colour graphics, prob. VGAπand usually 320 x 200. Notice that the colour maps have only 6πbits, the same as VGA's digital to analog converters. ".pic" filesπalways have colour maps, ".clp" files never do. It seems thatπyou can be lazy with your run-length decoding code; I've never seenπa full sequence appear across a data-block boundary (encoders shouldπprobably not let that happen). The amount of uncompressed dataπin a block never seems to exceed 8192 bytes.ππMuch of the header information is mysterious. Note that the headerπextension field is a guess and that there are other consistentπpossibilities (e.g., the extension field is a length byte or evenπpart of a length word). Only type=C images seem to have theπextension. Maybe the extra information is supposed to be usedπin video mode operating system calls on the PC?ππWhat made this part easier was the existence of a PC-based program whichπconverts ".pic" files into GIF files. Its called "cvt2gif" and canπbe found on wuarchive.wustl.edu:/mirrors/msdos/gif/cvt2gif.zip. Thoseπwishing to enhance the format descriptions would do well to get aπcopy. I did notice that bpp=1 images are not necessarily black and whiteπbut could be black and some other colour as selected from the CGAπpallette. I doubt the distinction will make much difference to theπanimation, but if you really want to do it right...πππCommand File (.txt)ππThe command file looks like a typical script file with the lines delimitedπby carriage returns, line feeds or both. Any text following ';' on a lineπis a comment. Text followed by a colon is used to indicate a labelπ(much like most assemblers). Commands consist of a keyword followed by aπlist of comma separated arguments. The input is case-insensitive exceptπfor arguments containing text to display (which are in double quotes).ππThe basis of the command language seems to be what I call picture andπclip registers, of which there are 16 of each. A few commands willπload a picture (or clip) from a file into a register. Other commandsπthen reference the register numbers to display the pictures or getπcolour maps from them. It seems that the colour map from a pictureπ(.pic) is installed into the hardware and this is where theπcolour maps for the clips (.clp) come from. I assume that I am missingπa lot of commands, but most notably I believe there should beπmore primitive drawing commands.ππMany of the commands seem to have a delay argument associated withπthem. This seems reasonable as control over time in an animationπis important. I may have been over-zealous in looking for delays.πThe actual time units of the delays is unknown. They are typicallyπnumbers < 100, so milliseconds are a likely candidate. Hundredthsπof a second are possible as well.ππHere is a list of commands. Optional arguments are enclosed in [].πRanges are possible in arguments (I've only seem them in fly) andπtake the form "n,-,m", (e.g., fly 0,0,10,10,1,1,1,-,16).ππ* box x1,y1,x2,y2,colour?πDraw a box with corners (x1, y1) and (x2, y2) in the colour given byπthe colourmap entry number.ππ* cfade x,y,delay,img,[,?,?]πDisplay a clip image img at (x, y) and wait for delay time units beforeπproceeding.ππ* cfree nπFree up any memory associated with clip register n.ππ* clearscrπClear the display (to the currently selected colour or black?).ππ* cload name,num[,?]πLoad a clip image "name" into clip register num. If name does notπhave a .clp extension, it will be automatically appended.ππ* color nπSet the current colour to n. This at least seems to affect theπtext displaying commands.ππ* exitπTerminate the command file.ππ* fload nameπLoad the named font which becomes the font to be used when displayingπtext. ".fnt" is appended to name if necessary.ππ* float x1,y1,x2,y2,step?,delay?,numπMove the clip image (num) by displaying it at (x1,y1) and erasing itπand displaying it every step pixels until (x2,y2). Delay delay timeπunits in between steps. Or maybe something completely different,πbut the x1,y1,x2,y2 and num arguments are probably coordinates andπa clip number.ππ* fly x1,y1,x2,y2,step?,delay?,clip listπSuccessively display the clip images from (x1,y1) to (x2,y2) with delayπtime units in-between. The clip list is just a bunch of clip numbersπseparated by commas (i.e., fly is varags). A range is likely toπappear in the clip list. Often (x1,y1) == (x2,y2).ππ* fstyle ?[,?]πPresumably set up some parameters on how a font is displayed.ππ* goto labelπForce flow of control to the given label.ππ* loopπDenotes the end of a mark loop. Continues the loop at the most recentπmark if the loop hasn't finished. ππ* mark nπThis pairs with the loop command and begins a for loop from 1 to n.πOne assumes that the interaction of mark, loop and goto is the sameπas for, next and goto in BASIC. That is, loops are dynamicallyπscoped and you can jump in and out of them. Mark simply pushesπa loop start onto the stack and loop examines whatever is onπthe top of the loop stack.ππ* mode ?πModify the current video mode in some way. I haven't seen this often.ππ* note freq,delay?,durationππPlay a musical note of the given frequency and duration and delay forπdelay time units afterward.ππ* pallette nπMake the colour map from picture register n be the one to use. This probablyπinstalls it into the hardware so that when a clip is loaded there isπno colour map to change.ππ* pfade effect,pict[,delay?[,?,?]]πDisplay the picture numbered pict on the screen. The effect numberπindicates what sort of special effect is used to display it. Whatπthe numbers mean I have no idea, but I know some of the effects.πEach pixel loaded randomly, every even line then every odd lineπand so on. The delay parameter seems to make sense, but not always.πThe extra parameters could be those needed for some effects. Oftenπthey are large numbers.ππ* pfree nπFree up any memory associated with picture register n.ππ* pload name,nπLoad picture "name" into picture register n. ".pic" is appended toπname if necessary.ππ* putup x,y,nπDisplay clip register n at (x,y).ππ* set retrace [on|off]πSet is probably a general internal control variable changing command.πWhat retrace is I have no idea, but it was set off then on aroundπa fly statement.ππ* spread ?,?πWho knows, but the numbers used are probably picture register numbers.πMaybe some kind of colourmap changing?ππ* text x,y,"text",[delay?]πDisplay the given text (enclosed in double quotes) at (x,y). Theπextra parameter is probably a display, but it could be the displayπcolour or the background colour. Probably the display colour isπthat given by the color statement.ππ* tran [on 0|off]πNo idea. Was used around some cload and float statements.ππ* video modeπSet the display mode to 'C' or 'L' (remember the image format types?).πUsually the first statement in a command file. C almost certainlyπrefers to CGA which is 640 x 200 monochrome and L almost certainlyπto VGA which (in their case) is 320 x 200 x 256.ππ* waitkey [[delay[,label]]πWait up to delay units for the user to press a key (or forever if noπdelay time is given). If the user presses a key and the labelπargument is present, transfer control to that label.ππ* window x1,y1,x2,y2,?πSome kind of display control. Probably a clipping window with appropriateπcoordinate translation (i.e., (0,0) becomes (x1,y1)).ππππThis document was created by looking hard at a number of GL files,πusing cvt2gif to help decipher the image file format and lookingπat 1 or 2 animations on an RS-6000 running a PC emulator and usingπgrasprt. cvt2gif was very useful; grasprt under the PC emulatorπwas painfully slow at times and didn't help my understandingπmuch. I've never even gotten close to a copy of the program forπcreating and editing GL files.ππIf you find out more about GL files, send me the changes so I canπextend this document. Feel free to include this as supplementary πdocumentation if you write a GL player. Finally, here are someπprojects which could help find out more about GL files:ππ- Get cvt2gif and feed it small variations on .pic files to decipherπthe meaning of the missing header fields. I may do this.ππ- Alter control files on some animations and see what effects theyπhave. Something easy would be to change the effect number onπpfade statements (if that's what it is). I don't have the hardwareπto do this.ππ- Look at the GRASP animation package and intuit what the commandsπmean by what control you have over generating animations. This isπprobably the easiest way to get information. I don't have GRASP,πI don't know where to get it and I don't has a PC good enough toπrun it on.ππ========================================================================ππGRASP/Pictor Font format description 09/06/87π------------------------------------ --------ππFor convenience, we have chosen to adopt the IBM ROM font format for data, butπto keep things manageable, we have added a 7 byte header which describes theπfont.ππThe seven byte header is defined as follows:ππWORD number of bytes in character data, plus this 7 byte header.πBYTE number of characters in set. 1-255 or 0 if 256.πBYTE ascii value of first character.πBYTE x size of character in pixels.πBYTE y size of character in pixels.πBYTE number of bytes in a single character.ππAs you can see from this header data, these limits apply:ππ1) Maximum number of characters in set is 256.π2) Maximum character size is limited as: xsize/8 * ysize <256.π3) All character data plus 7 byte header must be <64K in sizeπππWe use the following structure when writing programs that use fonts. Note theπadditional words at the end of the structure which allow you to keep the actualπcharacter data in a far segment.ππstruct chs { /* character set structure */π unsigned int numchbyts;π unsigned char numchars;π unsigned char ascoff;π unsigned char chxsize;π unsigned char chysize;π unsigned char chbytes;π unsigned int chsseg; /* segment of character data */π unsigned int chsofs; /* offset in segment of character data */π};πππSo....A 256 character 8x16 font's header would look like:ππnumchbyts = 4103 256 chars X 16 bytes/char + 7 bytes for headerπnumchars = 0 0 to represent 256πascoff = 0 start with 0 characterπchxsize = 8 8 dots wideπchysize = 16 16 dots highπchbytes = 16 1 byte wide x 16 dots highπππand a 96 character 11 X 18 font whose first character is SPACE's header wouldπlook like:ππnumchbyts = 3456 96 chars X 36 bytes/char + 7 bytes for headerπnumchars = 0 0 to represent 256πascoff = 32 start with 'SPACE' characterπchxsize = 11 8 dots wide (this takes 2 bytes!)πchysize = 18 16 dots highπchbytes = 36 2 byte wide x 18 dots highππ========================================================================ππππ PCPAINT/Pictor Page Format Descriptionππ Format by John Bridges.ππ Document by Microtex Industries, Inc.ππππππRevision Date: 2/9/88ππππGlobal Notes:π------------ππPCPAINT 1.0 - Revision 1.0 was developed for Mosue Systems in 1984 supportedπonly BSAVE files in CGA 4 color mode. In the space between the scan buffersπwas a string that read PCPAINT 1.0 followed by 2 bytes which were the palleteπand border information for that picture.ππPCPAINT 1.5 - Revision 1.5 was the same as 1.0 except that it contained largerπthan screen images and also had a primative packing format. This was sold forπso short a time that it won't be covered here.ππPCPAINT 2.0 thru Pictor 3.1 - This document describes these formats. The fileπdescription is identical for all revisions in this range. However, inπPCPAINT 2.0, the bit-planes were packed together so that the picturesπresembled a PCjr picture, or 4 bits per pixel, 1 bit plane. Starting withπPictor 3.0, the files were saved with the bitplanes separated. This takes aπlittle more memory in some cases, but the speed in loading and saving was aπdesireable consideration.ππNOTE TO PROGRAMMERS: A good PCPAINT/Pictor file decoder will use the variablesπ in the header to decode the image and thus be compatibleπ with all formats since the October, 1985 release ofπ PCPAINT 2.0.ππAlso please note that PCPAINT/Pictor are stored from the bottom up. This isπopposite that of most of the screen adapters it supports. This really causesπno problem, but be aware that you should use a Y table to look up scan lines.πIn all PCPAINT/Pictor pictures, the scan lines are continuous. If a picture πis to be displayed on a particular adapter, the programmer is responsible forπusing a y-table to properly interleave the lines if necessary.ππAlso note that Pictor was designed for speed, so no inter-mode loading isπpossible. If you are writing applications that create Pictor images that youπwant to load into Pictor, you must remain mode dependent. ππHeader - A full description of the file header information.ππoffset type name descriptionπ------- ------- ------- ----------------------------------------------------- π 0 word marker marker that is always 01234hππ 2 word xsize x size of page in pixels ππ 4 word ysize y size of page in pixelsππ 6 word xoff x offset into page where lower left hand corner ofπ viewport is located (default of 0 is ok)ππ 8 word yoff y offset into page where lower left hand corner ofπ viewport is located (default of 0 is ok)ππ 10 byte bitsinf bits 0-3 is the number of bits per pixel per bitπ plane and bits 4-7 is the number of bit planes (soπ 4 color cga mode would be 02h and 16 color ega wouldπ be 31h and plantronics 16 color would be 12h)ππ 11 byte emark marker that is always a 0ffhππ 12 byte evideo single uppercase letter indicating which video modeπ this picture was created in, can default to 0.ππ 0 - 40 col textπ 1 - 80 col textπ 2 - mono textπ 3 - 43 line textππ A=320x200x4 cgaπ B=320x200x16 pcjr, stbplus, tandy 1000π C=640x200x2 cgaπ D=640x200x16 egaπ E=640x350x2 egaπ F=640x350x4 egaπ G=640x350x16 egaπ H=720x348x2 herculesπ I=320x200x16 plantronicsπ J=320x200x16 egaπ K=640x400x2 AT&T or Toshiba 3100π L=320x200x256 vgaπ M=640x480x16 ega plus(video 7, tseng, paradise), vgaπ N=720x348x16 Hercules InColorπ O=640x480x2 vgaππ 13 word edesc extra information descriptor defines what is inπ the extra information that follows this header,π 0=nothingπ 1=pallet (single byte) border (single byte)[CGA]π 2=pcjr or non ECD 16 color registers (0-15), 1 byte eachπ 3=EGA with ECD 16 color registers (0-63) 1 byte eachπ 4=VGA 256 color info - 256 colors, 1 byte each rgb gun. ππ 15 word esize size of extra information in bytesππ 17 byte edata[] the actual extra data the size which is definedπ by esize (at offset 15).π 17+π esize word numblks the number of packed blocks in this file. if this isπ a zero, then data is unpacked. πππStructures - These C structures describe the header information.ππstruct head {π unsigned int mark=0x1234; /* marks begining of a page file */π unsigned int xsize; /* x size of page */π unsigned int ysize; /* y size of page */π unsigned int xoff; /* current x offset into picture of viewport */π unsigned int yoff; /* current y offset into picture of viewport */π unsigned char bitsinf;π}ππstruct extra {π unsigned char emark=0xff;π unsigned char evideo;π unsigned int edesc;π unsigned int esize;π}ππint edata[esize];πunsigned int numblks;ππIf the file is packed then what follows is a multi block packed file,πotherwise (if the file is not packed, numblks=0) the actual data follows.ππBit planes follow each other in the file and when packed each bit planeπmust start in a new packed block.πππPacked Block DescriptionπππPacked block headerππPBSIZE dw ;Packed block size. The size of this blockπBSIZE dw ;Unpacked block sizeπMBYTE db ;Unique marker byte. This is a byte that does notπ ; exist in the current unpacked block. If no uniqueπ ; byte exists, then pick one that is used rarelyπ ; to avoid too much redundancy.ππPacked block data - variable size depending on whether 16 bit run is needed.ππMARKER db ;mark a run (this is where MBYTE goes) πLENGTH db ;length of run. if 0, then look at BIGLENππBIGLEN dw ;16 bit run count (only exists if LENGTH==0)πDATA db ;byte to fill run withπππExample 1 - a 320x200, 4 color, packed page file, of a white screen. ππ dw 0x1234 ;markerπ dw 320 ;x sizeπ dw 200 ;y sizeπ dw 0 ;x offsetπ dw 0 ;y offsetπ db 02h ;2 bits per pixel and 1 bit planeππ db 0xff ;extra info flagπ db 'A' ;vidmodeπ dw 1 ;extra area descriptor (pal and bord)π dw 2 ;bytes in extra areaπ db 2,0 ;pallet and border (extra information)ππ dw 2 ;number of packed blocksππ;first blockπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0xff ;byte to fill run withπ;second blockπ dw 5+5 ;packed block sizeπ dw 7808 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 7808 ;16 bit run countπ db 0xff ;byte to fill run withπππππExample 2 - a 640x350, 16 color, packed page file, of a red screen (color 4).ππ dw 0x1234 ;markerπ dw 640 ;x sizeπ dw 350 ;y sizeπ dw 0 ;x offsetπ dw 0 ;y offsetπ db 31h ;bits per pixel and 1 bit planeππ db 0xff ;new extra info flagπ db 'G' ;vidmodeπ dw 3 ;extra area descriptor (pal and bord)π dw 16 ;bytes in extra areaπ db 0,1,2,3,4,5,14h,7π db 38h,39h,3ah,3bh,3ch,3dh,3eh,3fhππ dw 16 ;number of packed blocksπ;block 1 of first bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 2 of first bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 3 of first bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 4 of first bit planeπ dw 5+5 ;packed block sizeπ dw 3424 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 3424 ;16 bit run countπ db 0 ;byte to fill run withπ;block 1 of second bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 2 of second bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 3 of second bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 4 of second bit planeπ dw 5+5 ;packed block sizeπ dw 3424 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 3424 ;16 bit run countπ db 0 ;byte to fill run withπ;block 1 of third bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0xff ;byte to fill run withπ;block 2 of third bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0xff ;byte to fill run withπ;block 3 of third bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0xff ;byte to fill run withπ;block 4 of third bit planeπ dw 5+5 ;packed block sizeπ dw 3424 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 3424 ;16 bit run countπ db 0xff ;byte to fill run withπ;block 1 of fourth bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 2 of fourth bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 3 of fourth bit planeπ dw 5+5 ;packed block sizeπ dw 8192 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 8192 ;16 bit run countπ db 0 ;byte to fill run withπ;block 4 of fourth bit planeπ dw 5+5 ;packed block sizeπ dw 3424 ;unpacked block sizeπ db 0 ;marker byteπ db 0 ;mark a runπ db 0 ;a 16 bit run count followsπ dw 3424 ;16 bit run countπ db 0 ;byte to fill run withππππExample 3 - For more detail lets consider a block that isn't all the same.πSay the data consists of 30 2's, and 8, a 4, and 300 1's.ππ; the block would look like this ππ dw 5+10 ;packed block sizeπ dw 332 ;30 + 1 + 1 + 300 bytes as aboveπ db ff ;what to mark a run with,π ; because there are no ff's in our example.ππ db ff ;mark a run π db 30 ;8 bit run countπ db 2 ;byte to fill run with - 2ππ db 8 ;not a run marker, so must be dataππ db 4 ;not a run marker, so must be dataππ db ff ;mark a runπ db 0 ;means 16 bit run count followsπ dw 300 ;run count π db 1 ;byte to fill run with - 1πππThe actual unpacked data that resides in memory consists 2 seperateπsections.ππ1. The control structure: contains x size, y size, x offset, y offset,π segment of bit mapped data, number of bits per pixel and number ofπ additional bit planes. this information is kept in pcpaint's data segment.ππ2. The actual bit mapped data: contains the actual page image, mapped fromπ bottom left (so bottom scan line is first). The data is contiguous withinπ each bit plane, so scan line 1 follows scan line 0 directly. the pageπ can and does cross segment boundires (a bit plane can be larger thanπ 64k). each bit plane follows the previous but starts on a paragraphπ boundary, the printer driver will be passed the offset in paragraphsπ between bit planes and the number of additional planes.π The bit planes start with bit 0, each additional plane is the next bit.πππPaul Kuliniewicz MONOPOLY (LIKE THE BOARD GAME) home.aol.com/Borg953 04-21-96 (08:36) QB, QBasic, PDS 382 25281 MONOPOLY.BASDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"MONOPOLY.ZIP",4^6:Z&=18711:?STRING$(50,177);πU"%up()%9%%%.-%TiJdE2r;eE;eR%%=Y%&%1%%%%rt%stut(q(SgRfxeL$TA#2>aYπU"4H'u4UR/Dx<oA5:n,6U/JN>Y+Rrh$)a+]T88J\*GF*'?y:tmzv+u4vtAce/K1tLπU"L5m5UC671[P&yZn)<KcTD^#Y?)%;J)$hmI[7eGjsRsgZ&MCdGoYuWH>hhrp2N#^πU"/;M[YSSl5H_Nhp7]lJK.'d;sOG,lYH3rI#Y#/xfWSJLLgp,:$+#]:bI*N0#J=V[πU"].6l:$,Ymk6oIi^L[MM9PM)pR+H>>FgmXJ34Ub;-vt'kLi&AL.?[7IYlFG4Vn2yπU"gB>U)O\n&P8BBL=<r7cT$h2gV[5R(x1_?=mDht8UR%Qr#FH]QKfh?9U?#.Jz3Y1πU">;*O_8G8a6xt;o+20e['K\N1-W%WWCgG&#p7Q:T=[C9V^pt4E2F*s5JU2'>IbkNπU"\AP>ag],a%TPAkFVbFA+SvzI3Z(R'Oul.%\09hl+GO-FWc52?G>)<$gcC%JmaSeπU"#g2rNj(TP#0FYlb+(h0qjaqS'Z9V=^j,+r*(bBe,Psl&?xYAu>-I14p9]t+,gBMπU"fh>$ZI=&Cg_(%7PN7(?.X0ltRWYFC0CWSTgeVb]W)rWZo?aKCYKX9;npW%].,D[πU"/QDmE'M$jDeU<#ZX?rxLQ(XV9XGHIwlTbDXYDJT=KxAl]_U6V51S9.q]W3l.a=OπU".rjs9n.pdo\guTo4'j)]1Iuvr5T_hCtsmD-hXE2p#8Owm<WHgiJYK,UAHWhGXQRπU"5)QhHV#m^k&:d9*&H9R/.aNc<p>iCl\QB?I7M$[9#?ZZg>&P8K=fC^Fa$+R4A*MπU"-li;Xi&[K8&=3i.##k]mt.M/k>N7#Q^sFk(MtP2pqd69jZBb'OVsEnZcOWi&$odπU"&=12lzd\pJ1nqoJn0LV>^37hK#[SLPaYy6D>ER1k?JlKGd-L3w[yo/1,JV2=6]#πU"WPZiv87pAd06=CKH6Z%D$_]\>+))^#2V$ip8OT)8sA(''S1'.UUF^/:9C>(S*n[πU"%$.6cT62y5l]QZugw%YR,TDkJyl(TmM>jbH\G9\a9RtR)7\iFU-T?4H]N^R#CqcπU"DeGg9na35$k:Mi?h[Xxh.2'X2F5>eCLzykur0qUc>I.GY\8kqW1MqfJd8/O,x:>πU"$H0Q-6saphWEsz5VY)O=\a;q)\2([8q/^/AW#4UC\aunxUr[Luhr,%[Gc$roW<>πU"A_i#__<$*4?H<Q)JXGZh1JxjDuShW.Ih,uHDb0\E5]p1b>UdD<rO21xU+,oGY;:πU"beM'Hup6T\8Tdv=SRnt;>D\JdcuY+XtgZ?n[_uE'5F^bc33C1Mbu+Lgp9^u>k1TπU"[;;XJfk1>HsH)PURgSt6u?c2mbe1&W7:,G?WiQ)G1)I%1dv#''l]4\l>+gPwA\IπU"'d=kjt?axnS(xMfv92ai>t:A32XoA3N#&U%46:\Hn6UAf5MKuAwXA[^L7W3Naq&πU"7'Po7sHTvVsNMbSbWlZJH1Da)nFw$hJC5N\aihM)=OoLUr-oY2n3+bsvTpIw=^KπU"nD3?vwibecmbWP[3,O_k%^ga8mwepkrjxT7%;._pRIfY1Kdvhx%Y]>?k/$8YxoxπU">'f:t1G0>k3<ZB>H1QYOC:Xa:$xKW5I]K3YYX\lE4,KiABi5]ia'c1H]GEF&fM#πU"CYp$t3l9/2XNQ_hI2'qs6d(BDnD+Bi+KiiLgklx[6q#coPk2^USW9DkH]qLv$v'πU"o,mca):%-/U(gJc<r;xa)Zr8['=Ubd<z7T7ZYpHT5-0x)GT]g8zJ;ffY,7c+iL^πU"3ICdYZeFlrZC-?Bq(S3s'_6xp]*EXA9fVT#quqJ]<eH\lj%Ddgy;&qo=e\LrW9YπU"2s3*RDmDHHvEafK#_UfjhaSR#q3>'3Hm?)P#LL%6WQxDq<o;Jg7j)D1S<ueQ+cGπU">1UX^eZ:%K?#Jvgmr(f/U/c=B1dCX*_17TM(?2PA1^HG,qI,#dYiQt1eI<;?j4$πU",OC$CKVH[68x#(3.5G3c9bCRU)%pVo/GD8OZaH:CVsS6uvr'\S_Ugx6/&)(H3q>πU")M90<$#c1fV_Pd&+Se'LtI67Hu/2iU/uayATKh3FDgEOTGJlCR]gL<#=oYnpm)0πU"FROr0FroW]cfBi?n)3_7b1:3&tPt[j$2=6s\OWKju'm-TWJYLGuMx+e.lBMo$*AπU"O068#8rEi^IIK0^wbqEEXGfgU0Qw/Ys0wRK:p&n3/IiJvWn%L#CNmtobo\7lLfnπU"m#zGi3E\?5.]CEaZM7>Jhd)kSpbXxTQ(P_,Uh%u.4HwF9Hx,m)aPw*x?%q8?\[&πU"/d$Q(igdY*AU]gXEFf1slw&8B'Y<q9Cu.?.c6VE5'Fe\k]41-K6+SokVEU*/=tAπU"FReO3NSSYtd]MIIf25A^/:-dQlA(s[]2l6p/z0H,x+4%.Dm;..mZ9U]2wehq??\πU"<gE3?WnDld9R^mYCtKH<L<Al']6%G?%E)OLVUul:<]M8Kf0PJ/lj.)#-:l;H*.3πU"f#r%Ve#tI_%\Q50N)N=IYUfHC3=mm:(-KFCeS1K]'FYs_wFKHjg&/?0X&U==9ZKπU")TjUa0r,/eL;;]kU8P35^i]Lf-.JojE[l#+W4md?cop-tSXeRQk/.osLflCV4/&πU"he4$#m<0WT=B8O]S#U6W$rBJ_75c.=sqY$%KTsSq*;O5+iO#4(fS2Q_HI0J/2QGπU"d-n[#B3hgRD=*bNg/<?8V.1&]7hDuEY2/<3ILn5>9fP5=e.fi]A3>Pgy?xAWvS6πU"7OZvGn5QtXEIlE'VS;9-a%s]a%M$wvl=r>#su>&$Ft+#\VfS#k%#2Q:aWW1ZIc7πU"Dj'TP,v2a\dytBifjH1+,;vIO*?xScAhp5>I?tmwh#X+1P67I$:aE*-?av+\/L)πU"C\qr<JQl[*4HbPHCgyJa./b>0lcAZuFeIkR12otocb68ZX%6pRA^FeJ3XmcDEiEπU"O8e6s?d5Ia\8-E)l%Yl.BgRGGO3+?'&mRCw'$=C)>CgEGt;bEgqVgPP8$J<u<s4πU"0fL=9N%hM=Be-TV<oO5<;:#*^w8#q;Jw\)-w;:i8=UU);u<MJ1Nms$0AI6DMYI]πU"\IQ/xh#o2(i\YCZx6t)UmuMLqfV)aP7&#C+D*25_LObKOy:2/wf,ZbqkM7RDUJOπU">CDION3>QeG(K1Ir0-4O6hq:ss;cFLF_///9/l\a>/LsiAeI+B)g8:0+*f]b/'CπU"VQ,LRJd[(hA=z4FK]a9sPvReaUr\n&&So^l+UR*H+pEtQMF2E9T9XL\E$?#mD3tπU";'l+5s4K,]Y+ihi;?hmq#pUr+qjQ0#VO*^wb]p>mnw_xZK6XX)xN$cMe<ZLL#^$πU"Qi:O?eo\lY;ZCEOJA)fd[n%:Ki\ppP)X$a2O;a+4-2-q5T,?d;2I%81s2YbS'IpπU"V^H_RQ4,a^D[d_Dn%+8yf=#wuZ=H6;F;n]3--vMBEN+TOIVRbq&r8^Ijd\hSSYbπU"q(F>_t7b=fa%b:g3$e,OuG0Hk_]neDt]T\LYAn$[u$<eP/HIVL^INru)o$A.6_>πU"nF-]jesXm-cXnkj\.ds3[('n>g^Z:RHuvP020>?'_k:ts4VSSz+'].US#RARaF>πU"^?=bwla<'NWC7B4Tkgc>Sl,wTcD;\]8>,]X3vH0XJL7Qeg1QHOSk6MI^qE8J-k*πU"x.k4U0_#bODPSK,mPX4c;$GAW$rJiq_p<w2'k01B&N#ob.w/\ro.b(bV?^wud(HπU"Y$Pz1AK\nJ,*R78OZxfP.WxlwI_'kpAYB0X,m8We]>eOH#KBk$M%Ct_-oQzk$BXπU"6G9l&%MW\7sNKQH)0]m-RhKBBUK_[Mni/9T6IqjZU(pp)pxt25'-dM>SBe2M]04πU",Nc/l\-zUv_*/\efMuJUVx%w)HRBS4r>tq2;&dMX2fUTi=/l4QMg3:ojYER<.WUπU"py(ngR8HfJ;I\TOd/2JLH%:IJUTlQX/EN6wwuG?8$wPalDSdg%CO4$RY8)9#6e,πU"ZeJ#;_UU)_\?P0_gh[:,;f4$'fn<BK>j.Wjlxd,3Z/GcieNWJu8.ocbd-M%pEd+πU"OuJJ7_nCFM)T-?#qUlacXX)?c-\+bb;s<qO+qP#&_g0l3TFmkc_0u'tI2v_i,1%πU"xHy#?7$-*ESlUV:e#[4At4f8:5e?L4U,R5/PGENe;Qln,C4]%YY8EFfHS^RCAe5πU"F&,-EV%HeAG8.-96O<okIUP^'#CMO=O4Mn(H)ck'ivK(DAQ+#P:+7uyhK<OtL4YπU"m(D6=/<3<P_*cGU8MMF0,/<_MQmagEb)g>)5wJ>+:R(f_^[9FBRbKRe2;VoM+dlπU"R3G^=MR.f&4t%#qXLGm)3Slb/A[ga1\OeXi*>wH/Aq^2HiDVXTO<0;>/_Jn<uoOπU",)5%##F'Tel84(Duf-#q/0ZQ_(#Uhn==m%2D39f<(8/4S41>uV&=Z:.0S%8)IGGπU"uM#1>eeRIR=#C'6a%<KpUAQU-Hq](ya<QFgRcc>,qG1GTGRmMxT<x-iHu=DNAH'πU"K910<j;Y?beJX'Yq,CS\<g%.\<qxt&p;=vZ0iA,1*9NtM[z>yIe?ItmN.cn2-q6πU"xJ:.K_,\w$]J-ksQT9jLO/9I[R>)]IQh0c7&O0gG<NTX[n4rcl+.GBch)^rPK$=πU"O]mMY(:k+bw)x+PEGq,3&9Zzk<.04qo0./N20A\P4gr:OD<\$1E[M5P4)FYKKHkπU"cVf5:KIThxWmJ:*=lJ0#*GT4i&qMOUa/Xy'7*DZV]T2z7HkPWETsL\Cpe1tZ.O?πU"_)bYE(H:TRn&#H8Tbv(LI&3)&Z-M?]'9za]>It^8k:]AE-T;YteA1I-fga5e:X)πU"grP>8HebIqf-4WaYER*.k%4S]pT7PO0TJ[oR+nKM4kdBQq7jqH0tU*9m=GJU,XIπU"\NX'M4*Nb.((k#=08=J:EMm0:1mTi6XRtI4=P]',Z1%hcB'jp1(:SdUNNHb63R(πU"EsbG/W&nAh]/AQfXT:Q/OdW]CVc)e(V>BM*L[MV1#rw(Bv79D)QbSI<Ed=e=]LWπU"R^CCHa55ixk9wOC#1(dBMr2CgJ;%zG/Ayrpv6j=\d;l8K70uam9:EBNZt][O0ebπU"Y/8h_emTeb+d+bk7QJRd*5&IFk>?2SUz-4fl[%KGjSwj1<^8/[qB]e<Gl#V(xCWπU"rEvBP4^ryKDnv:AB<rki':7l-.FrOM&aJVuompAASGkN-)5nXJmW.gJjxaD]2.xπU"yIC*u'a1jq$-$H-J8I4)d1OSWyp\LPRweRVN8^En\p%(TEOCSiWBW*tH-]t$g72πU"lf>iYhjm8*^J/dp<N2)el;]u$A(eLO9>6A<'$M)j99qNYb[+C+6roM/v9YG_etBπU"s9Y\q)l5^>:u6Plh5GP4.tTIPPi7'+hg/Ek:RRViU%GGMA<8oCsthk3?o%0n+^YπU"sz$,4qj$TCnck3>=nI;T=[g[&UV61E'4-:=jAgCf#TqRJehxCOd<KeX?tst;[taπU"EKh:FNM_'b<waULpZcO&1'A;hR$;rm:uTdsnqd,-_vyf0ZIDPw+G9&JRmyY_<&1πU"qR^fxDq[)r)dY<(Xd]Rkb?h-qeI]8*1t_m+<oBhUq?sGp+q=,PMbf1YH\7,]w:ZπU"0q='4rOTh9;e_g&5QTXiwgCL5t\L1b%DM5VfyA[1T/L&9l*oDsXo,Dbebr;]mGFπU"(,bJhKU:SIJE+1Z]tW=#HG_1PDMr?'g?X(Id>P\*N#3jf[P3ZoOI$]B6FKQ_u_PπU"c^4D$PvsHmCMr]XpVw'jotU*:g'9\;NvZndA_R$;/=TU#\e11N/r#%'b9OrOkjvπU"rY9.mc1GAN*cg;lTmK\(s#FRVW0CUh3UNT+iA&2l\^V[PiL-jbE'1R)Og0<yWRYπU"mi_7o9(;a4,S?4))7h%<oE4z/+lXu/d[E6>(k^qreebb(Hiod-u,b^9yM9rej<ZπU",RcAej<ir4P13R,siN<a;EnoHd-Ohdc^k]:T0Hjbk-x[]KuD5YJLriU:Irid#jUπU">\J/oSlMD(NOeIeSAQL-Q\9:#87&kJa-iha-JDJ^CK*XbZLpY<_l.WH)V4uW,r?πU"-v\2&skzc-TCQ>y_[5524:x-=+kH1R8i&X-ZMy[[m_e2*i0g;re5.$FR0:+<up[πU"*uD#82itv-1oO]YFI#0Ab_OJ::t)FyEUN'FQdM.DP>UM&np<m#L<6,MrGAUf)mbπU"8-Q1jSc[rt?8JZiZj.$F\ME$$5,uAjICltaPm4x=yxqNUJLevtFI8;:I2Z)Y?(aπU"y7,Ua]e/w)SvP?>OdkcUSS'kWNQEe4I[+1_#6T?[0tBQ)V])A*g1Aa%dgXAH3PCπU"mIz)w$pDraFC;g+^7H]N5G>d+qi#0>/U,M#F'q;,Y(khpfFSuUII7(*/aL=GUs]πU"L63s<;DNUYfWia7.3;fSfk5j=F8Yb-[>33=Z3XmUbH=1C^V\EnfSS$bZ#jKi9VpπU"a8UHP]4'+K4HO45Vva1H'Ey%w#]e&AtFp%VWdrW/Ia>,_9Qg\<>1D6PJ?Ue2ZU*πU"qGaa5BSNVT_?9E82,YLgZw8u+DXIGeH'C(t-du<N^8NY8S7%$5M+*vnyO5^T2?>πU"*_Tba-certTgY=Ngmx/++n3,_oof'NgOFSiRB62f=CmJr)APg(Rd<[[weC6-NFJπU"351Y<4d^pNZ5.XZuN\10SnfFJ3%xd-E&C&)Mns6[gHU>',pg73^-;>E$o6P+OATπU"K2mKVA*wO]<fz/:nOnBE77XU5,2nEi[j4+I*;n\Wj7*jUwNb2V?&7$2$-NBn5uLπU"._^vf*tyQ?'X2+G[hZEXilhN$qPR?Wja3(eLu#$<+c+Cr#98Mh4PpI:BY5vHP5:πU"%_m0F;Af/5Cas7<&^(=J?V/[)7IBEKx&+i-8)QilK>+\?%GQ,)q^.D:TCph7Uf&πU"F$8)]Lt72b\aLqJ5xe'0p:IX+qlRxi7d5TMu;W\Mce7gOoQ8E<LcV#,CK'RCxPkπU"iW6>C=,uR,kuuW/L1'Vu'o&YtAtc6H2q23X43WgfUjWiO$d#^GA<l\u$-[rk+4wπU"57&[H(RWMTe$Ta;hGDTEi*b%RH#RKWre$8$;hM-TAn-Ql>ZgM4$FeD<ekp*0<H\πU"jRWp/qhl58A;X$HPVR5ETkC,\Qe-H^fRk5S*;oXWcL_bO9A=N8>-;AphjF'<KApπU"jF>'<AoGHa#hG8l3:g=h8lEg7=hjNo7<TErW0[2H\t7<dl7)5ECK#;Kzn^yxLCMπU"eyEVJUbT/;y&A6hQ04>%ijwIB&BVQ2%1Dp.&2_5C?Bn\27#8KR)^FCKinLVpi3LπU"lMEW1x+]gmp^WQLY3GrF:Bgc86=lLMMqqMbG]K:xu<p['i_GgO/bKCJbI*_E6?-πU"2Ii+v_WX1g*EBgQ1Fo5R[BG.xzd;S^$%;M]NU?/IUctX4q3<<B&ZwoYx7xmRT8>πU"^Jb%x.hj'Gg6ybLp-j3wq$w4-H#K*5W.wo:#uj$qOlBo1V?v[hg'$KFr4M0j\4?πU"E<2J?lcG+(<pjD,f^&Skxd&YbNHKFp3C>z7(G<hVk[uDp&SN4IDd*,Id0<V;m/EπU"KJ_r8V2SG04,XpuYC4m>&PlMof8ca]Rm>mDB>'0eFD:4fSqPQJDFP8R6x0g-/\9πU"5#A%#p]5sGRCWB/s7AQt=(KArw'G?8IsbHZK-lh5mZuOLv]8IWxXb>x(bYx_;WHπU"VcK+ZHB*sQX)xJs82wJeFYk9ui)xY1k]JUrw(.b#)iOkbsX)iDWYkEF3h0W*(C3πU"?k2M-GgD2Z&1yEii)p#fOlA\M2HaYvKKEbleg/Q$D:0%aqOb3lntn1A-JmR3-arπU"K6T*i1Ep:WBqgn)K2qHZM$C]<sPT,pYj<6v,E=7ujL\6?Rge4_c6gghVkjf*aE-πU"jY-3G(]q%Vc3kbCQ1VQ];'(j6?rWhr]oDNu$H)rF5sP>1kF*A^Y\P*&\:\SR9jqπU"5d>fww(I1cf)EG6(UI$/)a/iN2B_CGW2ln;2c:\6a6O>Fp%7yZPBEcgf=0#tmbEπU"+4J7Xyf2jKN9.AH=8K918xG[&(mZdB-*3K,HW9n6acp++.)ifK8s1GQ[Q?Ng7+(πU"C7o97:35aO$i>-/4Q1N,g76GsXvQE_Z\w(>^\^LfOn(RuMB7#j;\a^gK7=Pa>KjπU"u2G]XQI-w?iBYy6EwBOcCv[]ocJ8swK=tl#q[OFX&lUh6.H8QJmhdp0EIGHTCC<πU"3wLCAlyY'(;#1;67pX3Q^P-A35v<h6gG]cBS4YclS,*Kh$$^WksWg%imp%3+_n<πU"5ds9;4Ns]1icD$p$l[o<'?\1c;qtmJC9$on?X\I,LjfYsC3pCa18]aQ.4aICVgjπU"JKSb$sfbu]](m(u^2+3/+1wZBDT4F_[(kp)+'U.*.c0:hAZ$4C3#G$QlQe8hsKVπU"k%cL(q(v(m)s65X_^hAkD8N[>g8U(U0NK4%DS_\?/o&qO9)ymy.RFiDY0pT6&V*πU"s%1tYsF7a0qgYnu2V%X;]Xi5Bx%uXFVbsA>iUguUo#mdFT42F=Wv/k-5X'T9tU]πU"Ie=[tq%YMp-EI:k+1XJ<2+VH4\[i;-U4yvBF>t(.hJDJ1F,kC-A6kR>D6;4Wd_NπU"a(Qz>34H7#L3n=aI.^Gzrh(H<Rl_/;6FR4q*2E-*2_B*26W&UIe_)+TVrKfv+&YπU"Gz*7ZJ(oI;chfNq5%d,c$#9/33\pTBV90+)b^U8ZnDccwa1R$OY0desRltKN7_wπU")AOQiWrFA=Qf9>L%,I*JDJ)oz&./^N)eviof1tyWWa507ElyoD/i9L_r^rxDSalπU"xf6maNm6gh+Wn>nbATvWXT4wWQUe=\XG5ac%iU><7z8CeW+r<zUUe6/s5dzu9TtπU"N<&sf%rrhXJ1kqD.iViM45W2-#t-%Lhq&6Hg&$R8rkxo&C(R\42/cjYIo-&bMO8πU"n%tK28'$Hk3nQ%5BKZXhTHJt]tt?SP_fAYih=?,B(2)6\HjvhtsYdfYzBSnyQS\πU"HJs9$qUT\8av0/Qp[bbS:7;DTuf[nm#U9^*OPGhET<3p^?gUaHeq$*]YP3:iHAyπU"PZUlHU(T1]1_+&>)YyUlj6C9iCze;+%t,?YjEPN+foPvtI7SNX-ODz(Z37t4nzzπU"HNbF^9>*:iPZmVQ70<;NEuPVAQK^JeX+lf_];C+Iqx6*Z?28L>1Xbkapof3mp+kπU"3h#;:0oa2patBP*+N10\*J^Q7w>QW6khw1<x1;tV+?s(G_<e?f[Q3U)X^+c*5unπU"=n&he4*lVX5iw4gRErJ(YBtODoVe$,eH12y5qS9H1f%Nk.LdPC)pGBl=cL+yrT-πU"WQ7eW\o,]j1kqjZo?Y39rxp]#2ggr$j6K/.Qw$Y4+l'U]d#s3LxK3JZDInEH=>gπU"Dl,4m7uHnQoWpbkPy'SD:5-W7;fIbP+xY(g4CqRZ-&o594Qns13/3JRNfKyOnbgπU"I3txoD=lM_7,pdm*^epug%:3BTn)[-(Yqz=5L7Lj9MH2)QiblBj73&v;Rt1'4?kπU"\7DgQb'HVRtY9AKU;[PCJUw/a.B1\2XNSFmKW5EN'q9&G$'xJl'AU+Xof+93dt3πU"dJ#jgoKc1ri*W3XtS&cYc4q:_#(:7+$Pbk=tgxwXA'&>)t&ulSaS&ju&oBH9e>mπU"?hZqB3fIt$6WE%R_?ceaiGjo$]9MW(Z>F%nx7<LqHE1cr;9.41M\ZS%kR)Ab3.tπU"B&ZNv27:<>==/OYSFUL%G]2XcLp#dNfqP:bp91NJSFoWfBfe?u:/?TeWS3joO<9πU"ZEmU\6oel\<%:Z#%dtDuFfq2e4K29i_Y#xgY1QKBX8+Al1z\9t8o;fe7DboAFpXπU"4/%%-Zw7dkyB-nm5f$)]7?g8eRFcm4pbrzUO<5f1/\mw5*E>E>MFmHh9o?bXq.<πU"3T,vi_kZBU+Rw\U;dIxy:Imu&eeUG5G*]It5:d5:S+vvLm8MNx.[-?LUnKL:\:/πU"\A.$U8G'j[=K=0aH-k,7^jVp%IPC2?Gp^GG%N*WYt_sXfguzHUGr8pF7cT%Iw%pπU"aWK+<YXa6qbnqpX=Rrle'wayONPd>*Te?Vzu2Ev[O70Zvo7<2Wm/0wAhq-Qf2l8πU"S(K>L(A.S\x9:zPJxLjhnhK7KQ[?8GjqKRJF5'm06&8Up/F<lsq9L6Rb+9-)8[HπU"J2P?p-<U2J%ej9D3M8id<LF<XELMGP$,hNtB,kUfaC$i=93<>pIM*8S(yY>#;rzπU"N-,fw3k6J>_;?efr[[a$4+=mKDOu$<Fpa$VC(wK7<0.mAvhbYcSedH6&TE#Krg#πU"<&Gf&Dcp%q7[WrDlBSKnr,bhSuwUewX7-$'>;RUZE;_.1:qv9;M9]%o[M0uR)N%πU"\rJ3aq-2Zgi9e4.,'j-T0w6E;qj1M*^ZF;2rvj2,^M>uAYz>[Z:8.p;jDGsG94cπU"n$fgT9V)&oMof2Q]iuM>0mM)GWR)*F?xCSkNc<MJdS7#w.LIQAAXaN.7v0c?kXeπU"lmm7*J)CdH);4v5BX.-q:KJpZQ1;f:z#Z_]8U/Wt&&m92)8LlWc3..$O%N^s/nlπU"g/\8qPu1#+7?hq3;Yi.*T%KYzeSDN$gSm\n>%U>t&=+[PV=pP.o%\[op:w+C4m+πU"E4WRA,gnc.\o2>rmVPHi?-&g&h:wRci/ko4mc-5G$JM'=xD39x'pXRSGWTiT8fQπU"S(jp3/b'VvEZQg/uQ3uShg,42Uz9vHF/t)pH,9U0_U$dvjmh-[Vgu_i1+%Bxg(zπU"(OQ9+;#rt$fX#Nf\BNgO:4NxCJ$BkXBN3=%3c9x#m[G,R3$Z(L^DOlrzD8.bf1;πU"mEcMIv[vaN8SzDE%nJ^<+76X].\&eX_;wo=(86W$GqND;*D3lm.&mgPhPF$$/t$πU"GnsF]2HPl-T$QXgFB?\D)kQ<GbLbX>-dENEr\u&$wFVO(Q*6.9K_s7b)rB#-cVsπU"-o%9C?4AmqC=TaO^hh0AUGe$n1,pMK<+In,ap<&t0crkq.d*sI'(0OI'N,=7xgpπU"r[IZ&+O/+SM>)f)p)nqL9A4Yv1i+7rYnDHGhgT<6rff(4XT84wY<1raZ2p;^51,πU";8IfQTr>'&mS10.wk#qPcs5-xW_rxO3ErjCOZ3-Mi$/T3rLoBDjvXJ2+GTBgV$fπU")KAe1$E-#%*s]LYvCMh4.[gU<BR\K&YMRIAkJLM1]AG:D]ONyMYGkiqmb.YJkQXπU"DehUG3S,p;[dwC^HWTlg%C7<*A*KrI8s+ZcKBM]85/Mk&Le\\sGPT/*uN?zVD>_πU"c<B%5\>,%S>rnsWw\PG.x:$,.[tj6%IaOouzFT<0Bk?,8WXR$(hxh7ELhU$FJJ^πU"ffpGwuT(8w7$G89Z;]W?s;LN;_X7e]ATdJ#_s0VeVo8[pO%D$?a?9RJ:#K\,NpqπU"VPchVC#Knc=rY9YX<Ab$]zp#^wZC,#*yi=SQ(Ou.)46>YI)Z=_*p*Hy)iqk3fPDπU"FW7w0heI/0B]uI#7IaHi10V;7u5heM)[G+g'kq:$XZHDCW.FaO0Q$K5QV]6S$%#πU"'\SQ-M*.B8\'fSU)BAs((Y^Th_:#IXkjVMd#0;GDm0>xf+Jf#mF^,wGO;w_jUA9πU"4sUk6Yoj'M':%T4A$rKZ^/EPIW>NPo%3Yuo-PfGn=J:f%5Bo+-0E&#/h'(Me(IaπU"dBL(iU><Br.6+2W=;#V..(.b0LBOe4rhWR%U&p9phm>6_^l13D4]8g56+ao;3?FπU"vd:AF\QFj;(KO:Y?].hYBhn7U22:1bWJ5lmo8/s^_NG-FNutUa:s;E\s=GST_NWπU"eC[g\Ad6]aw8.[tthkai3s+$3f7z_rg[3VafN*V>E-,(%83Wk^LsJmB>,^oDL)pπU"f4BL<?L$ON$h8.F8j<YA6l<Yi:DYO)rer4ZonZJJHS%2AKs+xhPin;*A>=aR2beπU"VWP8=/.4cme;HmcUMWF<+2<jD);T-UoFl9Fytm;w<A+njOFX4\]*'<^us[i(>qFπU"S9-ru]srFXrMM;4MUhI:b.A\:7d5kr9i*o>Nl^GLL8LE,TA\->a0uXJG6TgLpxMπU";8;5UU[_TKxt7RFX)hN.oxiA_N99d#bda9k#CN[:9A_GdyAlriv'.U8&._wLE.PπU"U%liFUhzV>roYr*0U74dHv2%(&uSeS_hwYd]PJC&4uc]uMSsIlfpVh9PhR%7K(^πU"qMq^oKX2.#lLOvX;a'h9P+yScm]S;K/0a8h,$tbvhD;z_mP[/y;(;q61_JvY+%FπU")[yYklMe1fK<&WXMpC0+j9'7K>aK,d+uZWP7MHUXrWjZ0^S8fa7c/Z<4,W'%M.-πU"]2cV5K#2;6GBwk;_>)#)mBO&#<ou6.WTpO58;<BO)/JCVa.TJLfFfBp>I741HiMπU"208(g\M4tvj#4L*ltgUgCNHr[.P0\T5tpeZmG03Hr#a[Bf4Z-Yd&jM'g.pIqD]qπU"*6*;bXF-p^rTZ=anu^kC<C<OER[XNtD29ZK/FcLY$0+KZ0)kRu/kTHcB\P8FD]qπU"H^<6qV3ek*Q^:a\SNqEXIT0WR_YhGvg;EH4fNYAal>I4psAb2;emj1U*P7Y]2,kπU"W]\hgMt%7:(aHKV(k^HP50m)Hf$pG.eQLtx,iCquEJ,2FiqtIvJ:U(icEZWrbhrπU"s.2MFsw[R'FjP?1kiK;o1rVT(S&.U:7\og^\opAVq$T.d;<bd-j\Gvfp?y<c7;CπU"iF2ttp62N>ZGmh[qWZ.t[uAxEW#Top/hajd';0r0M_+er[*uwDC6SD;QZGaj_vGπU"=Izn3rSV$uY>aI;FVYBdMtGXjG>lEc')61^jmAKBX#G=0OIV^))zT4I.5-p(/\RπU"O]7aI$n*:nbmF^X'\w44Bir\Ysik_kX*%w446Br>Pl>(Q1nm#2G-;vqSkpITtB0πU"FaGa5&gjI2WyehJ##3P3O=nL=>i3Gy?W>P5)UM>Hsm<(]>LtW,L(JH.C_]:A5IPπEND SUBπSUB V2πU"L>mBr2TR1$cF6&eF\i2']<x'=#-E*/1\%ChYb/ZJ^L/qIhXnc'JphRlGyO5jI[+πU"0fOP5Kl$efuYVtR+ZSkPpYRo*5#[h-P.:)*pj[jBJ%7(i2\Qh\*Jj-v6gHw6Bf$πU"q>RCH88I)DQz?D.Pc\5uFw/>LbL0B+k5DnJk\-pNCN%wm'Z^vf0[/,=.t(gu;w$πU"pXJe8A+-tDrL83VPbvHM;k3Z$aiDo'6MJI*%Uuub<0NTKX[MxhU\y&QKd;)(5[:πU"iv5Wor?v*1dG\s&OBZ:;xtK#t#bO_rKk,BB(yA4&+;s].PNAEWgPPXElvl:]nk6πU"Rb*l^p+HK6Mw38Nnf9.c3TJiq0#>(,hvQ;,CwdxAh;iK6K\lDs00jVY;Ierah=CπU"vu9vSj72fK(ptj_Ld,/51:a*1??WL3q6/M5,$iPG5S9Jm#]qpTwx:1$#/mw%]6LπU"-GrOKu7:YDbT>ap.YjoMgacePeTb-rl0=L)V)pxE'p-=#Mi.xI>[^FW>i3glms.πU"OoQfDUbeN7ShaD-J'&]fqQ^dDE1g'ig&)pPgKwpUP.M8fn^q>sx8lDIYp&QQr#nπU":F*Dwc'a^G=m/#0bq5tW7Ous(wGhrodl[(5L]1[CA4cZ8:<5$u]\s;9)(v<ju;pπU"t4E]=P2kOb5.9Xf-<\cq1G4C20#th5EhkUaRfWmELNIUBMw[(c67)ws5q).SWHqπU"exiLk(m0T%rDWZtaFpSSLiQ'llUN$'E3j[\f5p0)I'ohv#g8BLqMi-k4)Fqke-EπU"E$dNnQE)dN=f+]<Fc]^FoD(em_o48Vbr-$6,u<v0oU5sgUoR+$:O3w^[Q&vWf:0πU"RjZ(j)PpJ.Ln)*p>SERPQ95lnV^I**6gx';5&sPT7Q3^e;q)DW/1FTL1-HG1\RBπU"C?D,\UbU#R<pgNOx:)Pt56j]1RThL,h%NrC**;HSc&eeMq_-h'Pi:HG\6u9\D[:πU">5>6vj9[/q,MIbNs=[#Ig<fztVQ0VU51G9/Dl+UyAxa1dnG$2Gbu^'$2wmuob'BπU"ix5#G$zg%PE5Qsu(b_q96%HP(9/C$q(;W4a*Zo/[Q%GL/Ad[G(mnJuNW4,5a$v3πU"D5,KPq;[]?vNnaYya^4J0WFLJuq4xm(z,lm-n+2WNukwbU\9EqvZ^EDX?_G$-LyπU"L6Eap--'=J(p^&n_cb7w=+7-q8+vg3L&/>G\OO5f09OM;CYO7wf)qs;Q6wNGY>xπU"87-l:lfwo[c6meg&PPO=>Cc7&linj(H_U.Yy[?00Kr>S?XE;#O*K-+tF%kWC)>oπU"<=bna7uJ)7W\$]P/99R7ZhI^P/9;R7OTs3QtYi;-mXF(P'MSY4W9-m<F-ONdBKWπU"V'sr:YOp['M6MzqT.?W?;?N:;B\P=QRta[3ePj+J4N6q+T655P[Vf4ncRO1,+]:πU"Yj>Bbsw9ohJ-\n%\YC[5Q&0GAfqn$I$j1hW0FkJ/[F#dOtWZLNY(w'bfTRi,Ux'πU"2Is%KX]WK%7(i*8%$FNuFTsz*MXz%8P>1v6Z)oGiY%07\HEj%*DK>GFXlM]RsWGπU"]1u*wLZMSoPcnBnzMTJ/>nX3rbzUUR%i&FRozZ6vv9VP,UTp+OhYP#C]qEpWEnnπU"qLn=^?OHTB2ckH;,?#IiSzJjdhs-ow'N:pL2-bU$YBBFcVCJ0U0K$o*,*61h]l0πU"WkL+TwVlNf_M0R())nN4kxIX)FAI:<CUZR/_S(S=0S'uz%c9bT=HANrPf0<zhXRπU"C'NIm2Ba1IbMKdhEb2wi;F5Ym+oh1CgkDVOAuq?uZ,TUcv1m[ZF6GM_N\-XQ/rqπU"tN1:kD=ro1\_7^cI>:+BZk\Z8N0Sv5eMM,cK1n&?^Fx>wKQ1w5&SChY[AGD\+pSπU"st2Tj\8kQd&=Sb'l>peC6IL::>Eo6pa2y/]e0.B_'jPcX4J1eX,)urOL[KF3H%\πU"g<MSioFW3(8KT-IlHaI.P>I<W]7Fz7Y6W*[-]<BFT:;54eBaBEao1>0KL2k_qYvπU"+Z#Ql(7'>j,5f,/l2'WqNO]#&e?LDtYK7Jd0/d\5ulaA$tAgqrV<Q#D&Xdx\H_)πU"Okf[VT?ryX(.Gji]tbA#L($f+f8:.Crh)4$6moi_kZUUR4\Dy1w30n=Jsf48).jπU"+$3+G68<cP3goOqmSD.;E/#D&hF^DR$a+aF:^4uIi'B3Q-;EsLN^Nq$%5<GILdUπU"Sw+_g<00'4-co=[6dqUY/>1<?OYh[LD3IJ*HU+KZ;]O&%W:?W)q0[eZU:]V/uEtπU"LO9Y(\/u-bdh[QpMLy.c(GX8Y(h$9G[<*xJp9BA4nQ7W_^lB][U^^cg>*IsqMOoπU"+g%z#u'20ycK\>.oVRk#.:]U&Y&>_QMuDi,O3N^*A(Y*^-w-1LGO,vfqsKT^k%&πU"nDw>h0KmABUg+v*fKsPfR?vfRqsT5OsT(k'/js8*tW:FFK9?M?HB4;$cMiWoL6EπU"weY8a8SE64+<?;-]OPr:&ATxU6rl3JK6C3A%gt/TmT3.E%]Z7tV7P<Hu$qf:j/:πU"4SY$ssL.Xk20(edK>P8'Bs;Y5ZvsVxN,SQKR^8Kns(ZS3OQti,*akO/fY*3Q8&>πU"S/f$h)aFv(S\LVBQ_Pe-K+J3liZj<J.Ncxztr#uBF*V/y6e%,^rtE5-\?<iV,[7πU"J-_sxik+[I?eqnp,orH3WW8gJcRSgT_^\?d#*lTBJ/4SpCn+NA,:.=KcYaf2u7&πU"(tde(dj$IP$<V1Br<X+BZNBT\UflmRHPn6#DoK/+I1>_U#mu,7ndhMr7[qSjP8HπU"(2g>a/0-W\IstO)_^n5ib0_m)vb#[pL/df(SMq>Ih4jSuZA=rNfr<L/xDj+-vp<πU"fJVUA='Q:JTU-N2p?.+VVVkLz188A&.nykI*dP_1fV>NDp1u:zKN_E2TtQFYK]EπU")1/cgO+*4ePxr$1\n/,Uk+X5K7E,[PE1q0*peNZ#Rj'=&[we4Qgl7x)PTc%06n_πU"0sYD41ILHvIr$)IH(in5#nQ5O*TuNf5OipZz$E.Mu'lVC:vQ)1I-fdlTNTl?0YYπU"tGCze-EDn>Qcrwp,;D&emTD)1#g*b5.c/LjS0I76M:IXr0I7Mn(j%Dbf3GG0^0,πU"6l\k4'hO>E7$A(*.olJGC:<F4eTY/?i/,E?*+HVS5B1'b2I<-+P,e,0)o'e#S0rπU"'6:D7G$.l[%Qr->G<^Mz/E:j9C+g?USA<$35vn;KxTTDymTD8VjN05s'-yr8'H^πU"fPT_4+gg:-8-Ft/OI(_N.*X;6$xE0_EAuf4PXO;(.(6S]D&:<%]x7(*&7%<=SWjπU"cr'9eQwA-*+1,$cQUC5Z9F2PP'YA<9=WLjb%PTq;Eg.j+qjQ;xMXYP1x4g+1=n\πU"1(V0PI*PgP*6'#*_%T[15Bz<p?W2.m02=UEST+1,-f'(E*$T#d*+1:;Iw9e1Q)[πU":(=Wjp]:'(*J7F)/#E;RRR01=qLjGPP,'-*uA/E;<#e9=W+jTD*L+1r//=R0E?OπU"8EeQE&-;4E_%Tn0E_O^T0E_0OT0EH_OT0=E_OTn0E_O^T0E_0NT0Eq))vu7RrwkπU")VR'7JR:Hznjpo-1mI3#M6,20L\bV:%jz-aA)h5DGc-L3r6q*,gk#zX9J'a>SXxπU"327g*u9axXj15n(IS2Y#7jbV<25==8sNbMnxu<cvq#fqNuj>z8sN9wnu9.2CXo<πU"iK>VOm8C4]kkIk>$hGmLa$AY'MP>]OKwX(nG7P?#QYrP4,ll#OXi;y/GoigckF(πU"VJaC_)ga/T_'*M;Gu,1ka,UJnvIIfF#O9*&Aj8=4i\ULb+fV#DaY)pb-;Y#gdHZπU"9dD(d<zZ6X?)?.[xy-P);+$\kZh'>+DO=k>d[0XZ?T50?#L;4JO7Ce^7:];+\jKπU"AVjBIXK\^+5djE30\*&l5ljE3i\<\jFiP6bdf>fm1Y-L*5;7P#n0]phc;=%n$(aπU"Mj,?*0$fL^+qeroWV/I7=ak\\yU9*V#I1Y,.ngYW4OAB>T6c)^o[aA;h0k&,nm2πU"/DC\.5$vkQLUYlBPoXv2dkVhHEq.mR\JTy?dH/Ipq='Dq3G3BCeMX^;Kw,C/bRBπU"Pl&5%%En*VF3^M=PL#FtPI0*,8howw?h)lN)t%$PBL3mP.U,huq4zCF/Q*)\<pAπU"4.:>y%JkCXz2z,mRmXN0$kMC\AEvs8F]]IzUqelLbe6Os(*hN6=49Ua:V=QHeDzπU"t$N?3r6mVbhhi:LIc\bnWLTdEcrSbWM):k6BcjP*?v_djA2*$r;$;fp?d%PmLkvπU"6z?%uRO;6s$P?X+]9py'(Xt^Oep7k+0WedTz,h%f3RpthC0E9MW%]AU*f\;PRXXπU"9EfFm(0k4+VHiP_Z)s8iT\Ds'6n4nsqUCMZ7%GII?cr$sqv48\=HijP5-ax$3aoπU"d6p5h.g*IM&m/>1^5Dv)K;ldLRSh?K)W4.eknM^E.RB\cf71)lk0Q_Ksugi6_J-πU";BNStS<(_xlB3,F9omJ(1-A/,uQ<5xi'N[3ToZ(J(%t5r%(h0o66bEVQ,;TKP#uπU"#O2fLQ+tdT)Dig4+LFi*(z;hX/8B8X)1]<pijK[UMXP,XKJMS_<.gfaaq_&?Jr6πU"yMlS'pt?qX$Z4G%K7M=9bSBtYF\h.qdrqk&_^A:7z*65/b9TYvtSY[t%[iH)Uj>πU"-#E2HZgkWUGWSW85]^p=?>*/2cf/oG6QD]45UXn>^qGAiPrJ^0]Upz(hEXb%pERπU"5/':pqP+XIP4_QZU)x]ky)w(Q=i93^MKMS,WjJKw;e9q0OiC0[BSP7tYX)Zv410πU"pvtaPXpIJG9/%BvmIS=z0ae.lu.*:EU]:8QNT2U*UFc#j[5*8Z%&&D8semJ5%87πU"*:pZE'FgErrf+BWh&O_a]3>5K?14;f;b,P%#5Am+fkqei>o\;nVlto=kA-OWg^ZπU"d2_fo-B)dpB=A3J8r#)>NS%M<_p;diW:l+[AA84oBQSO+rPqL#.L)1/[%:HF/.(πU"Yc*q;$r3>J)hT%(soQXE-5n7;Y3R4WSjF\2JbVhs9s,:+(uftK'GF$]oJif8)QIπU"L<McHybpdQ*SmrdtB%nP)bD^Y/rwo5)j\ZTcY$+w[tJ$lrQo0i:QDErEKOa96(sπU"fP79<d>462WdDoU]m/RE5#R$ufGC:w7+ZGa%'Y'mh4FXxX2bCR0(S6L/kPJRmB\πU"%,(7N^R\9.N=MEXp11n<[,FxX]-7Wp*D?g+E(AgU?(_C2?]ibelZ;$?4*.SzfHSπU"a:(MLzL>3c4anqYMDe?oU(0kg=efFz)AM0d4zqk7a\mhPLECNbZW]E(*jh%BAF^πU"gx3+M[#3=XgDG_sqlO&KE3LcEb43A<C3*QkF1(_NjUGJ1J'ed*YcKs6T\Ms(#HQπU"$:wd)c-WmW+^rLy=Q+UP6\j,C[Nfd/(HwAxicI+pdkI4p+IhDCI^>Lk)qZsE)mXπU"N__TG,/(.g:eN(R7avClmQ4.o#HQXx.3L5w,rmf&#Ed?=U<wX)$d=%*m3jAVOfeπU"4kI0&^bV>O^=Ow%dVF%e7_28Ok;0mNM=,5mHO3mba3O7;0c>ipl>;7Xa>)6ZX>IπU"MIIlBLeBGIp2Jsc&72/Cx:hYgGVZAY.t16PG8Z_WR.GRe1X=8**yH:+/\_<xl-9πU"cj[S^vuz$cUH?v4GvYpC_,yPD.sJNdConoacxIDJCFj;UKXrV9b\THntZMMLk%qπU"d\$m#vR(*.SS;Y,Ib,C5tOxE_I_yhBh[>lF3rp&i_-Zl5Tj;E4'\ec9iGK^JNaOπU"(ek,w\zJWI-Bj[9Kt3i=R*ST5RpATe>q^aL1O4^;eykd'oA32A.ypM-S3[WBLJBπU"7qaQ^^<BBRB4u=NqA0(<l]2.YQe8mnZ8w+7DhFjpFq^qGFjogI:vexb=;wg/<(_πU"+)iBd-3=89-t3Sa'UED.B$sum]'?.a,3a&3Qgo/sV[MX:NA34eSrdL\TBFi?cj2πU"DxY;*x%/*&>1tp3+z)MXs+$^VI6$Ug-kDnRcpSbsaE7+=RomNrs6mHEeq/>e;C2πU"<Q:A>SRm3$+Y%YeoPdCYL9-,NO_uFU^_0fbm33?%gga9xh?&Zr)SH)s&_oDq^?QπU"ad299617][*K(G)7edU?i2*?5;Erq1t?BU$^nvCWpeIBD(c-c;^r:ibns6dsSCcπU"Rw5$6nW&BBGJ6eWkt%d^:[Br\^WmN)bS&y6HT>T8qO,uf72U>BcYdur'L2:r;%.πU"8WI.PWaFNr$?^FGCxUWw=k?*/g%TSZ0-_[cEhe;Q8)\.c960314m:6bl4Tw/FKcπU"hT-FrZudLJvtNHhakh%q\\=JkM0JGNh>e%XU#+QFvbVkd^mRX_?LgE>2,$pKM75πU"+^P:g_&6,oSl^4GS)Ng3[_Z-LdAmad=]pPOWQ;jPSH0ZkQqg6=42hZFPU\F8_/yπU"hXO[#2l6Z$h3R<$lZe8roQ;_awWq24XHkey3AjXcCFtZ4k23.Bn3fuQeGlrjsvuπU"M,>s$pJ=DD:w5iKSfWFAA57Jp\-HdTHMVW<3]3d8iP[Xt6jrs$nGca7*PX8[<I4πU"[1G]LwuPh1KH',q'LM3jI,OFGaWM:pn1N;IRb?$67cZE=&=Jh]RF3)c8KUS.e;bπU"bQ.Rf>OSqp,?[o:vJKLtrf%&;Zt1NIR66ADPdW\Z=RrA56$z>?TMh/e#2X1p(CWπU"g%aD1$uHH43RO60gY4[kc2Xltr3eKDgp\Yl*8>oQDQ?Q^m7D4T:6NI:n*^]IXWHπU";AD'_c.Z41*K>_4JkDh_).[azmgTRpZ6a3eyEEC4+C]FqLL4Ve_#n&NuR46S=$=πU"IWf7'FStN\eDqNgu0rG2/9Lse;;H[XD1>]/a9l[<fW[0Xjy)>j-hHI-&*&Z2,H;πU"Xw82][50l[rkDK8Gtf_ep_Ump?y:<_LyS5^,;R>s_sHEFMa\rQIKA4PI(AQJo8SπU"9;IsLs=5i.1l6wE_5YX%f=]rDQ_vi0ozi3U/7S&'_YXr5Ul&NeBXioA\Y.qjkNOπU")HKxqRSk:IC/oq4kAiq,s4w_5YgBg7+.*vrYj.SQKfMOobpuh:E+Y^N-J0g+b&uπU"hHrux86d*t8#+6;xYl1NRTrEI<TR&D41)^?9D?B=0wf4fM%e5).0:6tdf$jLblfπU"J3ne.Fi^*9reZ(jZVRX6\nz<*2UI1yU]S'g4Jc:y'3bS/3\y00-AX9-X1P[sVPtπU"gPb2DvlDq*/KAraAF+4[9EqKoOmaKQzqYohX\\mL#p)rr8qJ1ugEJhSzNX7TTl%πU"sleGhQ?$G_I<7#noE+c68.,IpJm_9+GYsn'eAhtBAAImKX55u.E>:_tn&u$62H.πU"%D9iM.RiY,$_(E3I1A3aBE&^Np;jXrbf,f13i+YFfusu[kC9JJW_rY>;ML<&u:_πU"oF$F\N7ZUsemS[yi1TC>y#WgOU('6u:klSbS6as.nodcKHAJ4WR74<7CFmEXY4JπU"(6_iybSk/eOZO'WE2ULb&gegTJuX&wn=WP4S8fo)5k25\3Qru=?%bs^TWZVsB&eπU"YtIF[U<r=7PL;QM1%L0%fTYVm<-DygCe$uxWCbvj?>1*H#0mBhH*PXj\^cj3v,SπU"BAU0k_\[*C3RBH.yp[3n2XlYl']L_&hlysl7c%G7momR5T2e<Nd(9i)[;au/lxsπU"]4?tJ:(YEd=fTT\?6_v=0Y\F.9U8\&[r,EJQVYAfqo*:^Sgj2B^/)k2PiC<7e2qπU"7;o^):#aEgis2-,LhT5m?Ueeftl?ZkQ2VM&RH;fCJ5KGx2aEb^g\AJsxRHNe^HDπU"e9U^FfGv%:S2<H3?d/6+PzwXGcPE5\jv-vS?Z\k>#LPTKM;4U^j.5#%L2O'g7I6πU"XuCEZ)gdI6<J$>c.M55;7:n;Yuo%J'0-2i$I61\C]x(48prYwV%<Ro#KP4wNUq#πU"IrcoMc[qMV*<&3uOo8;nfsQO*DU[IDmdt)Ry=HC-;9ik2_)tkRbh(][0GHKD*MGπU"V-KYM#*#SKkiX=PZK0qJ>IVj(H9]RBX/c?r2K6OYu2;k6m8oNR_Mf+RUM2\,0SuπU"Jk_nX^OLC+e-5\4tb5XLfWHemTk^jw_G2WoZH5_Z>3_j1>2:riV0iAn1g4]c5jOπU"YGsT(:Gqu8XwD%urg:ja>Z-#s:EDc'Dc_P<+1Pfn.9H:4l$lhd*1-<D')[aA6$_πU"s,Gu5)+41BYj%Pf;D75fk,l)0a](YFEtohTT6n.aF6ZJ4&r>gwDp^.bA_-BEBTNπU"uurLT*XS^g)p^Z6&2:1G-HPiWw+B8nBZ*V2JHTChs8n3)2(#,UQJf?e\D-7KP*VπU"<qZt0in:hsVF,#BJ(80d'VB?o22?ADV%Ai<+hY,7,t^x?ZKY^^BBnW&wXG0mKdBπU"+rsWkC)Zszpu3mw[5Cu)nO:Ye)]vTIAYFumMHZfxeX)UxoB.%up()%9%%%7-%kiπU"edE/a;T]v+%%%C3%%%1%%%%rt%stmj%quSyJ'yD&;,>T]C;L<oix?6)f9]O[eEVπU"g>u/tI3W/)4DQ[9#iub7JK-.>2jS9mC-ZH(XJOnC#u,,947Lj-mBNgv>%r0z4NKπU"k#KL^bM2l)AH,Da<D7Yrh>Wu+(gK4spqk)b+USCu#>mXMHe6j+kaL]ehCE?JQhTπU"d)fI4\UkjGwBLt%jdk_oX;NI$fb7\#-BilTcomLa%rR*J_D(4vGN%0JQa$JPq0KπU"PxJpC4n$Dg<ES/R3Sj#5,FdfQOIkseD)IFC&kn;6q'R._\Keq,RRJ7H&QnqT3dOπU"DGK#&)9R3-#6ykJ(FD]GmOtYklEoY7jW&PEg]$8JSq_:-UC7<%p](:l,5P?g(/uπU"hPf5YIE+W*u-J]mq5LR9H_jZ*dSX#)1vJL3]\0%?Gg6e9*vIbV?p^9<G4A<U+D8πU">nWah2oJJP1K5:>S&RUK($>4U<(LLBP/bXp(14.;G_:1Mz7IaYU/$hC7Etv]AJ;πU"xL*aksSk&PgqrR?m_]W.SiT_=C/P^9'4S[0u\uo;FFSH_XO:3Sx/4f^w6P_'5d,πU"lS\;$Zd/4w;Do&kAq#epP3<AH[Z<NT:]^h8R]U4he+&s#bB^IXiM0X)G-R06;DdπU"$U+0PC1YixWs]U#t<^7j$ZoW#Zl4\_7J+>e9c91,3%SmbBN0jy7/tOm8%9]KC+\πU"[,ZasfhTb;v$u6E#v<JkFl2V+OP0kQ9Ae%J#0,U5bM<d)kb'rR5He;3]A\nB]RVπU"EY*$5rt7a=)R?U%mp1f0\VSlU&,AU2n>NC+W;,6\2M7u_>uLaM3GZk;[<#n]1X[πU"c>uB?>;Hse+tSK+j^B)I8H>Qtz#h9qE:AG76Gm1/wIq-WGnf\GJFrWe\3-zd_FkπU"#s)DAGwf/(rK/)95kmCsuLj-6N(\8ptiiFs\q1%&,^H]2)LUMj6C#\:3A81z4;RπU"fnc3n^Gg*>$E[Kv^mX3&md::SbBU2i9lQ>R0OF;/S_$aD0A2)-Us2)uGZ7D'SntπU"Jt^HZR/b*-jMT3GjJ7;Q_(%T6DAcMxEm0LzO_9Ug5nSJ7^Ga.%p_78Lsm/cRZPhπU"C'8=:&ZiYJo/dco^8KjJ=r9]pA1=NR.Po%8C2fXbLmk[5DnKt%JY<w*3l%LsTN1πU"n6gryE2N\d7\e0bj$*L<l[VEv??ZpG-.^Cjk/y>HKL_E_dl;\Zcm]5[C.A0>W&UπU",_C#Qo2n&TyT*F-tTX]*?q^>>86S[gy:9%NVGT,F?^n)Q,ftS1.qS1C%L-%r[1DπU"CR1M'&k%c9J?T*C(Vc+Lr$(1tb4*4C7<hinXc,ft][UrN,X&jR1S7BF^VR81edzπU"wBCK8ha>_02D*hIB1e;vSwjAu23q]=MwaWHw<#1ZS5ER^GTJxLxWK_A<YPwIk8UπU"tmJu<O'8<DJKfwfPd+WWovM:G->cbd/aAQ-5q5pISp>h/o_LdI25V'0--NQk&#UπU"vS:t*F2iBg/C]obtX;;ZIaN>;p1w:%PVt/%w5RIpp7OHcu+TiE.LJp#QodpcFp4πU",1giP?Om&ZD.K%$NwAcEjL7\trbwb+#]uaGba\.6+UN_<Kdr%_qSSm3YJwpj;I:πU"PJBLDE1ukT8mQfh&4tHtGi;gWMayaVaGI]MJ6c$Y2Bgo]^2s4F(ZM1Zh^J]JEqkπU"ywnH);sg//5m.TCy+jjEF%/td*1=X#2e0I>f+p1]oAJw;-k72P\a-PT<jbb4m^mπU"h\A,e?68q:xk6Ce$8G:$uN.,;-tsUM[sp_4QtUphjwm-m^O%pKe%$ihXamdhNVuπU"\'Ac[+[?yB:V9HCHgoeU;\_7G=M6;WpeZ;OP.R<WYGpKom42Fm0<6Z,,tf$QxHcπU"01Mi/'fLiF9,9EVIZJ;gemYSlTC^6uw8bQ22H-)hdDCpcL[peH^h:GYoaKJ'SuZπU"HF0G[ilH%w;M&'\g*cjb=]Hw_Y9<aRc*t\86vs-=dZK#(g'S3oem%L?KV3uUf$NπU"1fd6knPrLN776Q8$RWEJUrN^#EsiF.WLqeX;xf;w?lolU[0d^n^oZ;C4F3h/CdfπU"2Tt4jN8*hk36M=WfjDJnXr23V*e)+nKNZT]c&C$^Pgt7be)Sh,%dr^4([#4>rTNπU"HVK+u-lG'WI-SM):(C+H2S[?jvl)nJ?m$;O1]*kt/,6;O&hBpHdqw=;<?tGC;b8πU"<>9-2X)LqARg%0RO;BX=wHRISril4gZ?5K_,NGFKC>m70]3)cei-&uM6#I8h3KnπU"I4AB^*?y?C,H-K^VOe*W(XHMXkHOGXW6LnyIVR]bOy(aZHZs_S=]#b6U:L:csTxπU"$X-Wx%u%p()9%%%%-#%Pjd7E?&4%g;%%+%;&%%%1%%%%rts%tutq&(Sxf>%f9V%πU"&%%%GQ)O3(UN^P)?I];,TL/u%p&'9%%9%%#%-%TCidE2hreE;[e%%=&Y&%1%%%%πU"%%%%%&%%E%%%%%%%%%rts%tutq&(Sgf%xup&%'9%9%%%%-F%kidUE/aT,]v+%%%πU"C3%%%1%%%%%%%%%&%E[%%%e%e%%r%tstm%jquS(y'yu%p&'9%%9%%%%-%P(jdE?πU"'&4g;[%%%;%&%%1%%%%%%%%%&%%E%%%%8m%%%rts%tutq&(Sxf&%up*%+%%%%%(πU"%(+%'%%%%xm%%%%%πEND SUBπV2πCLOSE:IF S=162AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπAkarsha Vasant Kumar QBASIC PCMAN avkumar@giasbm01.vsnl.net.in 07-07-96 (00:14) QB, QBasic, PDS 539 18490 PCMAN.BAS '--------------------------------------------------------------------------π'||||||||||||| QBASIC PCMAN ||||||||||||||||||π'--------------------------------------------------------------------------π' --- Akarsha V. Kumarππ'HI !! I'm a high school student and I waste a lotta time programming inπ'Qbasic ( My mom doesn't like it one bit tho !!)π'I haven't really completed this game . You can go ahead and completeπ'it. I have used the screen function to find which charachter is printedπ'at a specific point .This greatly reduces the program size and speedπ'as one does not require to feed in the maze data into an array .π'The mazes are printed at the bottom of the program and you can make yourπ'own mazes as I have done by simply typing in the designs .π'The program should work on any maze provided to it .Don't blame me if it dosen't !!π'The program also includes a subroutine for drawing bordered boxes .π'The monsters are not very smart and are absolutely incapableπ'of chasing MR.PCMAN very well .Moreover , the monsters delete the numbersπ'while moving over them . You can make the necessary additions .π'I'm too LAZY !!π'NOTE : The program may crawl on slow computers . Try compiling it .π' Better still , change the delay timesππDECLARE SUB DRAWDBLBOX (X1, Y1, X2, Y2)ππTIMER ONπRANDOMIZE TIMERπLEVEL = 1πSCREEN 0, , 1ππFOR I = 1 TO 5πCLSπCALL DRAWDBLBOX(40 - 7 * I, 10 - I, 40 + 7 * I, 12 + I)πSTARTIME = TIMERπDOπTIME = TIMERπLOOP UNTIL TIME - STARTIME > .05ππNEXT Iππ LOCATE 8, 18: PRINT "░░░░░░ ░░░░░░ ░░░ ░░░ ░░░░░░░ ░░░ ░ "π LOCATE 9, 18: PRINT "░ ░ ░ ░ ░ ░ ░ ░ ░ ░ ░ ░ "πLOCATE 10, 18: PRINT "▒▒▒▒▒▒ ▒ ▒ ▒ ▒ ▒▒▒▒▒▒▒ ▒ ▒ ▒ "πLOCATE 11, 18: PRINT "▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ ▒ "πLOCATE 12, 18: PRINT "▓ ▓ ▓ ▓ ▓ ▓ ▓ ▓▓ "πLOCATE 13, 18: PRINT "▓ ▓▓▓▓▓▓ ▓ ▓ ▓ ▓ ▓ ▓ "ππLOCATE 15, 27: PRINT "PROGRAMMED BY : AKARSHA V. KUMAR"ππLOCATE 22, 35: PRINT "PRESS A KEY ...."πDO: LOOP UNTIL INPUT$(1) <> ""ππFOR I = 1 TO 5πCLSπCALL DRAWDBLBOX(40 - 3 * I, 10 - I, 45 + 3 * I, 15 + I)πSTARTIME = TIMERπDOπTIME = TIMERπLOOP UNTIL TIME - STARTIME > .05ππNEXT IππLOCATE 8, 29: PRINT " USE THE FOLLOWING KEYS ...."πLOCATE 10, 42: PRINT CHR$(24)πLOCATE 11, 40: PRINT CHR$(27); SPC(3); CHR$(26)πLOCATE 12, 42: PRINT CHR$(25)πLOCATE 14, 37: PRINT "S ==> SHOOT "πLOCATE 15, 37: PRINT "Q ==> QUIT"πLOCATE 17, 35: COLOR 10, 0: PRINT "(+) ==> PACMAN": COLOR 2, 0πLOCATE 18, 35: PRINT "[-] ==> MONSTERS"πDO: LOOP UNTIL INPUT$(1) <> ""π1 LIFE = 5ππCLSππ'declarationsπDIM MONSTERROWπDIM MONSTERCOLπDIM MONSTERORIENT$πDIM DIRππ'determine which maze to drawπIF LEVEL = 1 THEN MONSTEREDRAW = 0: direction$ = "": GOSUB 9999πIF LEVEL = 2 THEN MONSTEREDRAW = 0: direction$ = "": GOSUB 9998πIF LEVEL = 3 THEN MONSTEREDRAW = 0: direction$ = "": GOSUB 9997πIF LEVEL > 3 THEN MONSTEREDRAW = 0: direction$ = "": GOSUB VICTORYππSCORE = 1ππLOCATE 22, 25: PRINT "LEVEL "; LEVELπDO: LOOP UNTIL INPUT$(1) <> ""ππSHOT = NUMMONST * 3ππFOR I = 1 TO NUMMONSTπDIR(I) = INT(RND * 3) + 1πMONSTERPOS(I) = 1πNEXT IππSTART:ππ'redraw maze if all monsters are shotπIF MONSTEREDRAW = 1 AND LEVEL = 1 THEN GOSUB 9999πIF MONSTEREDRAW = 1 AND LEVEL = 2 THEN GOSUB 9998πIF MONSTEREDRAW = 1 AND LEVEL = 3 THEN GOSUB 9997ππLOCATE PCMANROW, PCMANCOLπPRINT " "ππK$ = INKEY$πIF K$ = CHR$(0) + "H" THEN GOSUB UPπIF K$ = CHR$(0) + "P" THEN GOSUB DOWNπIF K$ = CHR$(0) + "K" THEN GOSUB LEFTπIF K$ = CHR$(0) + "M" THEN GOSUB RIGHTπIF UCASE$(K$) = "S" THEN GOSUB SHOOTπIF UCASE$(K$) = "Q" THEN GOSUB QUITππIF direction$ = "LEFT" THEN PCMANCOL = PCMANCOL - 1πIF direction$ = "RIGHT" THEN PCMANCOL = PCMANCOL + 1πIF direction$ = "UP" THEN PCMANROW = PCMANROW - 1πIF direction$ = "DOWN" THEN PCMANROW = PCMANROW + 1ππIF PCMANROW <= 1 THEN PCMANROW = 19πIF PCMANROW >= 20 THEN PCMANROW = 2πIF PCMANCOL <= 1 THEN PCMANCOL = 57πIF PCMANCOL >= 58 THEN PCMANCOL = 1ππ'check if pcman hits the wallsπFOR X = 0 TO 2πA = SCREEN(PCMANROW, PCMANCOL + X)πIF CHR$(A) = "#" THEN SOUND (150), 1: GOSUB CHANGEDIRπNEXT Xππ'check if pcman hits numbersπFOR X = 0 TO 2πB = SCREEN(PCMANROW, PCMANCOL + X)πIF VAL(CHR$(B)) < 10 AND VAL(CHR$(B)) > 0 THEN SOUND (300), 1: NOOFFRUITS = NOOFFRUITS - 1: SCORE = SCORE + VAL(CHR$(B))πNEXT XππGOSUB DRAWMONSTππIF LIFE <= 0 THEN : FOR Y = 10 TO 14: FOR X = 25 TO 44: LOCATE Y, X: PRINT CHR$(178): NEXT X: NEXT Y: LOCATE 12, 31: PRINT "GAME OVER": SLEEP (2): CLS : SYSTEMππIF SCORE > 200 THEN LEVEL = LEVEL + 1: GOTO 1ππCOLOR 10, 8πLOCATE PCMANROW, PCMANCOLπPRINT "(+)"πCOLOR 2, 0ππLOCATE 23, 1, 0, 0πPRINT "LIVES :"; LIFEπLOCATE 23, 20πPRINT "BULLETS :"; SHOTπLOCATE 23, 40πPRINT "SCORE :"; SCOREππGOTO STARTππENDππ'change direction if pcman hits wallπCHANGEDIR:πIF direction$ = "LEFT" THEN PCMANCOL = PCMANCOL + 1: direction$ = "RIGHT": RETURNπIF direction$ = "RIGHT" THEN PCMANCOL = PCMANCOL - 1: direction$ = "LEFT": RETURNπIF direction$ = "UP" THEN PCMANROW = PCMANROW + 1: direction$ = "DOWN": RETURNπIF direction$ = "DOWN" THEN PCMANROW = PCMANROW - 1: direction$ = "UP": RETURNπRETURNππLEFT:πA = SCREEN(PCMANROW, PCMANCOL - 1)πIF CHR$(A) = "#" THEN RETURNπdirection$ = "LEFT"πRETURNππRIGHT:πA = SCREEN(PCMANROW, PCMANCOL + 3)πIF CHR$(A) = "#" THEN RETURNπdirection$ = "RIGHT"πRETURNππUP:πIF PCMANROW = 1 THEN RETURNπFOR X = 0 TO 2πA = SCREEN(PCMANROW - 1, PCMANCOL + X)πIF CHR$(A) = "#" THEN RETURNπNEXT Xπdirection$ = "UP"πRETURNππDOWN:πFOR X = 0 TO 2πA = SCREEN(PCMANROW + 1, PCMANCOL + X)πIF CHR$(A) = "#" THEN RETURNπNEXT Xπdirection$ = "DOWN"πRETURNππ'subroutine for shooting bulletsπSHOOT:ππIF SHOT = 0 OR PCMANROW = 1 OR PCMANCOL = 1 THEN RETURNππSHOT = SHOT - 1πCOLOR 10, 0πI = 1π'check for walls around pcman and draw bulletsπ170 IF direction$ = "LEFT" THEN A = PCMANROW: B = PCMANCOL - I: C = SCREEN(A, B): IF CHR$(C) = "#" THEN SOUND (100), 1: RETURN: ELSE LOCATE PCMANROW, PCMANCOL - I: PRINT CHR$(27)πIF direction$ = "RIGHT" THEN A = PCMANROW: B = PCMANCOL + 3 + I: C = SCREEN(A, B): IF CHR$(C) = "#" THEN SOUND (100), 1: RETURN: ELSE LOCATE PCMANROW, PCMANCOL + 3 + I: PRINT CHR$(26)πIF direction$ = "UP" THEN A = PCMANROW - I: B = PCMANCOL + 1: C = SCREEN(A, B): IF CHR$(C) = "#" THEN SOUND (100), 1: RETURN: ELSE LOCATE PCMANROW - I, PCMANCOL + 1: PRINT CHR$(24)πIF direction$ = "DOWN" THEN A = PCMANROW + I: B = PCMANCOL + 1: C = SCREEN(A, B): IF CHR$(C) = "#" THEN SOUND (100), 1: RETURN: ELSE LOCATE PCMANROW + I, PCMANCOL + 1: PRINT CHR$(25)πLOCATE PCMANROW, PCMANCOL: PRINT "(+)"ππFOR DELAY = 1 TO 200: NEXT DELAYππIF direction$ = "LEFT" THEN LOCATE PCMANROW, PCMANCOL - IπIF direction$ = "RIGHT" THEN LOCATE PCMANROW, PCMANCOL + 3 + IπIF direction$ = "UP" THEN LOCATE PCMANROW - I, PCMANCOL + 1πIF direction$ = "DOWN" THEN LOCATE PCMANROW + I, PCMANCOL + 1πPRINT " "πLOCATE PCMANROW, PCMANCOL: PRINT " "ππ'return if bullet goes out of maze limitsπIF A >= 20 OR A < 2 THEN RETURNπIF B >= 60 OR B < 2 THEN RETURNππ'check whether bullet hits monsterπFOR X = 1 TO NUMMONSTπIF MONSTERPOS(X) = 1 AND B >= MONSTERCOL(X) AND B < MONSTERCOL(X) + 3 AND A = MONSTERROW(X) THEN PLAY "CFC": MONSTERPOS(X) = 0: LOCATE MONSTERROW(X), MONSTERCOL(X): PRINT " ": SCORE = SCORE + 50: RETURNπNEXT XπI = I + 1: GOTO 170ππRETURNππDRAWMONST:ππ'draw pcmanπCOLOR 10, 8πLOCATE PCMANROW, PCMANCOLπPRINT "(+)"πCOLOR 2, 0ππ'erase monsterπFOR I = 1 TO NUMMONSTπIF MONSTERPOS(I) = 0 THEN GOTO 5πLOCATE MONSTERROW(I), MONSTERCOL(I): PRINT " "π5 NEXT Iππ' if monster moves out of maze , produce it at the other endπFOR I = 1 TO NUMMONSTπIF MONSTERPOS(I) = 0 THEN GOTO 20πIF MONSTERCOL(I) <= 1 THEN MONSTERCOL(I) = 55πIF MONSTERCOL(I) >= 57 THEN MONSTERCOL(I) = 2πIF MONSTERROW(I) <= 1 THEN MONSTERROW(I) = 19πIF MONSTERROW(I) >= 20 THEN MONSTERROW(I) = 2ππ' check if pcman touches monsterπIF PCMANCOL > MONSTERCOL(I) - 3 AND PCMANCOL < MONSTERCOL(I) + 3 AND PCMANROW = MONSTERROW(I) THEN PLAY "EC": LOCATE PCMANROW, PCMANCOL: PRINT " ": LIFE = LIFE - 1: PCMANROW = YY: PCMANCOL = XX: SCORE = SCORE - 50: RETURNππ'This routine checks for walls and changes monster directionπ'Have to develop a better logic for this part.πSELECT CASE DIR(I)ππCASE 1ππFOR X = 0 TO 2πA = SCREEN(MONSTERROW(I) + 1, MONSTERCOL(I) + X)πIF CHR$(A) = "#" THEN GOTO 10πNEXT XπMONSTERROW(I) = MONSTERROW(I) + 1: GOTO 20π10 A = SCREEN(MONSTERROW(I), MONSTERCOL(I) - 1)πIF CHR$(A) <> "#" THEN MONSTERCOL(I) = MONSTERCOL(I) - 1 ELSE DIR(I) = 4ππCASE 2ππFOR X = 0 TO 2πA = SCREEN(MONSTERROW(I) - 1, MONSTERCOL(I) + X)πIF CHR$(A) = "#" THEN GOTO 30πNEXT XπMONSTERROW(I) = MONSTERROW(I) - 1: GOTO 20π30 A = SCREEN(MONSTERROW(I), MONSTERCOL(I) + 3)πIF CHR$(A) <> "#" THEN MONSTERCOL(I) = MONSTERCOL(I) + 1 ELSE DIR(I) = 3ππCASE 3πA = SCREEN(MONSTERROW(I), MONSTERCOL(I) - 1)πIF CHR$(A) <> "#" THEN MONSTERCOL(I) = MONSTERCOL(I) - 1: GOTO 20πFOR X = 0 TO 2πA = SCREEN(MONSTERROW(I) - 1, MONSTERCOL(I))πIF CHR$(A) = "#" THEN DIR(I) = 1: GOTO 20πNEXT XπMONSTERROW(I) = MONSTERROW(I) - 1ππCASE 4πA = SCREEN(MONSTERROW(I), MONSTERCOL(I) + 3)πIF CHR$(A) <> "#" THEN MONSTERCOL(I) = MONSTERCOL(I) + 1: GOTO 20πFOR X = 0 TO 2πA = SCREEN(MONSTERROW(I) + 1, MONSTERCOL(I))πIF CHR$(A) = "#" THEN DIR(I) = 2: GOTO 20πNEXT XπMONSTERROW(I) = MONSTERROW(I) + 1ππEND SELECTππ20 NEXT Iππ'Draw monstersπFOR I = 1 TO NUMMONSTπIF MONSTERPOS(I) = 0 THEN GOTO 60πCOLOR 10, 2πLOCATE MONSTERROW(I), MONSTERCOL(I)πPRINT "[-]"πCOLOR 2, 0π60 NEXT Iππ' Check if all monsters are deadπFOR I = 1 TO NUMMONSTπIF MONSTERPOS(I) <> 0 THEN GOTO 100πNEXT IπMONSTEREDRAW = 1πFOR I = 1 TO NUMMONSTπMONSTERPOS(I) = 1πNEXT Iππ100 STARTIME = TIMERπDOπTIME = TIMERπLOOP UNTIL TIME - STARTIME > .1ππRETURNπ πVICTORY:πCLSπ LOCATE 8, 8: PRINT "█ █ ██ █ █ █ █ █ ███ █"π LOCATE 9, 8: PRINT " █ █ ██ ██ █ █ █ █ █ ██ █ █"πLOCATE 10, 8: PRINT " ███ █ █ █ █ █ █ █ ██ █ █"πLOCATE 11, 8: PRINT " █ █ █ █ █ █ █ █ █ ██ █ █"πLOCATE 12, 8: PRINT " █ ██ ██ █ █ █ █ █ █ ██ █ █"πLOCATE 13, 8: PRINT " █ ██ ███████ ██ ██ █ ██ ██"ππLOCATE 22, 35: PRINT "SCORE :"; SCOREπPLAY "O2 L5CL8DE-P14FL4G>P10 C P14 <L5A-L7B->CP14<L4G P8 L8FE-P14DL4C"πSYSTEMππQUIT:πLOCATE 23, 1: PRINT " "πPCOPY 1, 2πFOR Y = 10 TO 14πFOR X = 20 TO 39πLOCATE Y, X: PRINT CHR$(177)πNEXT XπNEXT YπLOCATE 12, 23: INPUT "QUIT ?(Y/N):", ANS$: ANS$ = UCASE$(ANS$)πIF ANS$ = "Y" THENπLOCATE 1, 1: FOR X = 1 TO 80: FOR Y = 1 TO 23: LOCATE Y, X: PRINT " "; : NEXT Y: NEXT XπCLSπCALL DRAWDBLBOX(15, 5, 69, 17)πLOCATE 7, 17: PRINT "This incomplete game has been written in QuickBasic"πLOCATE 8, 22: PRINT "You are free to distribute it as you like."πLOCATE 9, 22: PRINT " Suggestions on how to make those stupid "πLOCATE 10, 18: PRINT "monsters move more sensibly are ever welcome !!!"πLOCATE 12, 28: PRINT "Do send in comments at:"πLOCATE 13, 27: PRINT "avkumar@giasbm01.vsnl.net.in"ππLOCATE 15, 30: PRINT "Thanks for playing..."πDO: LOOP UNTIL INKEY$ <> ""ππSYSTEMπEND IFππLOCATE 23, 1: PRINT " "πPCOPY 2, 1πSCREEN 0, , 1πRETURNππ' These sub-routines contain the data for drawing mazes as well as monsterπ' and pcman init positions . You can add your own mazes . If you want toπ' increase or decrease maze size , some minor changes have to be made toπ' the prog. parts which check if monsters.etc have strayed out of the maze .π' Try to follow a similar pattern while making the mazes .ππ9999πSHOT = NUMMONSTπ LOCATE 1, 1, 1π NUMMONST = 3π NOOFFRUITS = 20π COLOR 2, 0π PRINT "############################################## ###########"π PRINT "#### 4 ######## 4 5 ############# ###########"π PRINT "#### ######## ############################ ###########"π PRINT "#### ######## ####### 1 ##"π PRINT "#### ######## ####### ################## #### ####"π PRINT "#### 9 4 5 ################## #### ####"π PRINT "######### ###################### 9 ################ ####"π PRINT "######### ###################### ############# 2 ##"π PRINT "######### ###################### ################ ####"π PRINT "######### 9 ####### ############# ##"π PRINT "######### ############ 5 ####### ############# ## ##"π PRINT "## 7 ## ############ ############# ## ##"π PRINT "#### ## ############ ############## ## ##"π PRINT "#### ## 9 ###### ####################### ## ##"π PRINT "#### ## ### ###### ####################### ## 2 ##"π PRINT "#### ## ###################################### #######"π PRINT " 5 4 1 "π PRINT "#### #### ################################ # #######"π PRINT "## 8 #### 9 ############ # 2 ###"π PRINT "############################################## ###########"π πFOR I = 1 TO 3π140 MONSTERROW(I) = INT(RND * 20) + 1πMONSTERCOL(I) = INT(RND * 56) + 1πFOR X = 0 TO 2πIF SCREEN(MONSTERROW(I), MONSTERCOL(I) + X) = 35 THEN GOTO 140πNEXT XπNEXT Iπ π IF MONSTEREDRAW = 1 THEN MONSTEREDRAW = 0: RETURNπ LET PCMANROW = 20: YY = 20π LET PCMANCOL = 47: XX = 47π110 RETURNππREM ----------------------------------------------------------------------ππ9998 SHOT = NUMMONSTπ πNUMMONST = 4πNOOFFRUITS = 38πLOCATE 1, 1, 1πCOLOR 2, 0πPRINT "### ########################## #########################"πPRINT "### ########################## # 9 4 ###############"πPRINT "### ###### 6 1 # ### ###############"πPRINT "### 1 ###### 3 ########## ######## 9 ### 9 1 8 ##"πPRINT "### ###### ########## 4 ######## ### ######## ####"πPRINT "### 7 ########## ############## ######## 3 ####"πPRINT "############ ########## #### ####### ######## ####"πPRINT "############ 2 ## 8 #### 5 ####### 8 2 ####"πPRINT "### ###### ## ############ ####### ######## ####"πPRINT "### 1 ###### ## 9 ############ ####### 7 ######## 5 ####"πPRINT "### ###### ## ############ ####### ######## ####"πPRINT " ###### 5 ################# 6 "πPRINT "### ###### ################# ##### ##### ### ###"πPRINT "### 4 ##### 8 ##### 3 ### ###"πPRINT "### 2 ########################## 3 ##### ##### ### 4 ###"πPRINT "### ########################## 7 ### ###"πPRINT "### 8 ######## ############# ### ###"πPRINT "### #### 6 ######## 9 4 ############# 3 ###"πPRINT "### 3 #### ################### 1 #########################"πPRINT "### ########################## #########################"πFOR I = 1 TO 4π150 MONSTERROW(I) = INT(RND * 20) + 1πMONSTERCOL(I) = INT(RND * 56) + 1πFOR X = 0 TO 2πIF SCREEN(MONSTERROW(I), MONSTERCOL(I) + X) = 35 THEN GOTO 150πNEXT XπNEXT Iπ IF MONSTEREDRAW = 1 THEN MONSTEREDRAW = 0: RETURNπ LET PCMANROW = 3: YY = 3π LET PCMANCOL = 4: XX = 4π π120 RETURNππREM ---------------------------------------------------------ππ9997 SHOT = NUMMONSTπ LOCATE 1, 1, 1π πNUMMONST = 5πNOOFFRUITS = 37πCOLOR 2, 0πPRINT "###### ###################################### ##########"πPRINT "###### ###################################### 1 ##########"πPRINT "###### 6 ####### 9 ################## 2 ####### 9 ####"πPRINT "### 7 ####### 2 ####### ### ####"πPRINT "### ####### ## 9 ######## 9 ## ####### 4 ####"πPRINT "###### ####### 3 ## ######## ## ####### ##########"πPRINT "###### 8 ####### ################## 5 ####### 3 ##########"πPRINT "###### 1 6 ## 6 7 ##########"πPRINT "############## ###################### ##################"πPRINT "############## ###################### ##################"πPRINT " 4 7 9 ######## 9 4 1 "πPRINT "############## ###################### ##################"πPRINT "############## 4 ###################### ##################"πPRINT "###### 1 5 5 ##########"πPRINT "###### ################## ################# ##########"πPRINT "### 6 8 8 6 ##########"πPRINT "### 3 ################## 7 ################# 4 ####"πPRINT "###### ################## ################# ### ####"πPRINT "###### 1 ###################################### 9 ####"πPRINT "###### ###################################### ##########"πFOR I = 1 TO 5π160 MONSTERROW(I) = INT(RND * 20) + 1πMONSTERCOL(I) = INT(RND * 56) + 1πFOR X = 0 TO 2πIF SCREEN(MONSTERROW(I), MONSTERCOL(I) + X) = 35 THEN GOTO 160πNEXT XπNEXT Iπ IF MONSTEREDRAW = 1 THEN MONSTEREDRAW = 0: RETURNπ LET PCMANROW = 1: YY = 1π LET PCMANCOL = 7: XX = 7π π130 RETURNππSUB DRAWDBLBOX (X1, Y1, X2, Y2)ππ'CHECK FOR VALID CO-ORDINATESπIF X1 > 80 OR X1 < 1 OR X2 > 80 OR X2 < 1 OR Y1 > 24 OR Y1 < 1 OR Y2 > 24 OR Y2 < 1 THEN GOTO 101ππIF X1 > X2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERX = X1: LESSERX = X2πELSEπGREATERX = X2: LESSERX = X1πEND IFππ'DRAW HORIZONTAL LINESπFOR I = (LESSERX + 1) TO (GREATERX - 1)πLOCATE Y1, I: PRINT CHR$(205)πLOCATE Y2, I: PRINT CHR$(205)πNEXT Iππ'DRAW VERTICAL LINESππIF Y1 > Y2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERY = Y1: LESSERY = Y2πELSEπGREATERY = Y2: LESSERY = Y1πEND IFππFOR I = LESSERY + 1 TO GREATERY - 1πLOCATE I, X1: PRINT CHR$(186)πLOCATE I, X2: PRINT CHR$(186)πNEXT Iππ'DRAW CORNERSπLOCATE LESSERY, LESSERX: PRINT CHR$(201)πLOCATE GREATERY, GREATERX: PRINT CHR$(188)πLOCATE LESSERY, GREATERX: PRINT CHR$(187)πLOCATE GREATERY, LESSERX: PRINT CHR$(200)ππ101 END SUBππAkarsha Vasant Kumar QBASIC ROAD RACER avkumar@giasbm01.vsnl.net.in 07-07-96 (00:16) QB, QBasic, PDS 338 9873 ROADRACE.BAS' ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░π' ░░░░░░░░░ Qbasic Roadrace ░░░░░░░░░░π' ░░░░░░░░░░░░░░░░- Akarsha V. Kumar░░░░░░░░░░░░░░░░░░░░ππ'Namaste ! That's Indian for HI !! I'm a high school dude and I waste lottsaπ'time programming in QBASIC ( My mom doesn't like it one bit tho !!)π'This was one of the first games I wrote and it works pretty neatly althoπ'the code has been written in a very haphazard manner (I was very new then).π'I have absolutely no idea about how it will look in color (We in India findπ'it difficult ..sob ...to afford even a mono monitor ...Boo Hoo Hoo .....).π'So please sympathise 'n do something about the color attributes I've setπ'if you get wierd combinations like pink 'n orange ( Har Har ....)π'So all you Sennas out there ...... get set and go !π'Happy playing !!!ππ'NOTE : Runs fastest when compiledππRANDOMIZE TIMERπTIMER ONπSCREEN 1: CLSππCIRCLE (165, 85), 50, 1: PAINT (165, 85), 1πCIRCLE (160, 80), 50, 2: PAINT (160, 80), 2πLOCATE 10, 16: PRINT "ROAD RACER": SLEEP (2): CLSππLOCATE 10, 14: PRINT "PROGRAM BY :"ππFOR X = 2 TO 13πLOCATE 12, X - 1: PRINT " "πLOCATE 12, X: PRINT "AKARSHA KUMAR"πSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .1ππNEXT XππFOR Y = 20 TO 14 STEP -1πLOCATE Y + 1, 11: PRINT " "πLOCATE Y, 11: PRINT "D.G.RUPAREL COLLEGE"πSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .1ππNEXT YππLINE (50, 50)-(250, 140), 1, BπSLEEP (1): CLSπDOπPRINT "USE THE FOLLOWING KEYS:"πPRINT : PRINTπPRINT " LEFT AND RIGHT ARROW KEYS TO MOVE"πPRINTπPRINT " F1 TO ACCELERATE AND F2 TO DECELERATE"πPRINTπPRINT " Q TO QUIT ."πLOCATE 15, 5: PRINT "PRESS A KEY"πLOOP UNTIL INPUT$(1) <> ""πCLSππ'Init variablesπ1 X = 0: Y = 10: Z = 190: A = 150: B = 195: I = 1: : SOUNDLEVEL = 1000πSTARTTIME = INT(TIMER)ππCAR$ = "U20 E3 R7 F3 D20 L12 E2 U15 H2 F2 R7 E2 G2 D15 F2 H2 L7"ππDOππCARX = A: CARY = -50πI = (RND * 4) - 2ππLOCATE 1, 31: PRINT "Time": LOCATE 1, 36: PRINT "Kms"πLOCATE 14, 1: PRINT "Speed "ππ10 LINE (100, 0)-(100, 200), 1: LINE (220, 0)-(220, 200), 1π'Get inputsπK$ = INKEY$πIF K$ = CHR$(0) + "K" THEN GOSUB LEFTπIF K$ = CHR$(0) + "M" THEN GOSUB RIGHTπIF UCASE$(K$) = "Q" THEN GOSUB PLAYAGAINπON KEY(1) GOSUB SPEEDUPπON KEY(2) GOSUB SPEEDDOWNππ'Time graphπLINE (240, 10)-(260, 190), 1, BπLINE (240, 190 - TIMETAKEN * 9 / 10)-(260, 190), 2, BFππ'Distance graphπLINE (280, 10)-(300, 190), 2, BπLINE (280, 190 - (DISTANCE / 1000) * 5 * 9 / 10)-(300, 190), 1, BFππ'SpeedometerπLINE (50, 50)-(75, 200), 1, BFπLINE (50, 200 - SPEED * 10)-(75, 200 - SPEED * 10), 2ππIF CARY > 200 THEN GOTO 20 'Check if obstacle car has moved out of screenππIF SPEED = 0 THEN CARY = CARY - 3 ' If your speed=0 then move obstacle in opp. directionππKEY(1) ON: KEY(2) ONππLINE (95, X)-(100, X - 95), 1, BF ' --πLINE (95, Y)-(100, Y - 5), 1, BF ' |πLINE (95, Z)-(100, Z - 95), 1, BF ' |__ Draw side linesπ ' |πLINE (220, X)-(225, X - 95), 1, BF ' |πLINE (220, Y)-(225, Y - 10), 1, BF ' --πLINE (220, Z)-(225, Z - 95), 1, BF 'ππ'Draw FinishlineπIF FINISH$ = "WIN" THEN LINE (100, FINISHLINE)-(220, FINISHLINE + 10), 2, BFπPSET (A, 195)πDRAW CAR$ππLINE (CARX, CARY)-(CARX + 20, CARY + 35), 1, BF: LINE (CARX + 5, CARY + 10)-(CARX + 15, CARY + 30), 2, BFπLINE (CARX + 5, CARY + 7)-(CARX + 15, CARY + 10), 0, BFππSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .01ππLOCATE 1, 1: PRINT "Speed :"; INT(SPEED * 10)πLOCATE 2, 1: PRINT "Crashes :"; CRASHπLOCATE 3, 1: PRINT "Kms :"; 40 - INT(DISTANCE / 1000)πLOCATE 4, 1: PRINT "Time :"; 200 - TIMETAKENππSOUND (SOUNDLEVEL), .03 ' create that irritating noiseππLINE (95, X)-(100, X - 95), 0, BFπLINE (95, Y)-(100, Y - 5), 0, BFπLINE (95, Z)-(100, Z - 95), 0, BFππLINE (220, X)-(225, X - 95), 0, BFπLINE (220, Y)-(225, Y - 10), 0, BFπLINE (220, Z)-(225, Z - 95), 0, BFππIF Z > 240 THEN Z = 0 'πIF Y > 240 THEN Y = 0 ' Check if sidelines move outπIF X > 240 THEN X = 0 'πππX = X + SPEED: Y = Y + SPEED: Z = Z + SPEEDππLINE (A + 5, 175)-(A + 15, 195), 0, BF ' erase carππ'Erase obstacleπLINE (CARX, CARY)-(CARX + 20, CARY + 35), 0, BF: LINE (CARX + 5, CARY + 10)-(CARX + 15, CARY + 30), 0, BFπLINE (CARX + 5, CARY + 7)-(CARX + 15, CARY + 10), 0, BFππ'Erase FinishlineπIF FINISH$ = "WIN" THEN LINE (100, FINISHLINE)-(220, FINISHLINE + 10), 0, BFππDISTANCE = DISTANCE + SPEEDπSYSTEMTIME = INT(TIMER)πTIMETAKEN = SYSTEMTIME - STARTTIMEπCARY = CARY + SPEED / 2πCARX = CARX + IπIF FINISH$ = "WIN" THEN FINISHLINE = FINISHLINE + SPEEDπIF 200 - TIMETAKEN = 0 THEN LOCATE 11, 16: PRINT "TIME UP": BEEP: SLEEP (2): : STATUS$ = "LOSE": GOSUB PLAYAGAINπIF FINISHLINE >= 170 THEN LOCATE 11, 13: GOSUB VICTORYπIF 40 - INT(DISTANCE / 1000) <= 0 THEN : FINISH$ = "WIN"πIF CARX > 190 OR CARX < 100 THEN I = I * -1πIF CARY = 190 THEN GOTO 20πIF CARY > 135 AND CARY < 195 AND CARX >= A - 25 AND CARX <= A + 15 THEN SOUND (190), 1: GOSUB CARCRASH: CRASH = CRASH + 1: ELSE GOTO 10ππ20 LOOP UNTIL CRASH = 10πLOCATE 11, 13: PRINT "CAR DAMAGED !": BEEP: SLEEP (2): : STATUS$ = "LOSE": GOSUB PLAYAGAINππ'Routines to move car ; decrease & increase speedsππLEFT:πIF A = 100 THEN RETURNπLINE (A - 2, 197)-(A + 17, 160), 0, BFπA = A - 10πPSET (A, 195): DRAW CAR$πLINE (A - 2, 197)-(A + 17, 160), 0, BFπRETURNππRIGHT:πIF A = 200 THEN RETURNπLINE (A - 2, 197)-(A + 17, 160), 0, BFπA = A + 10πPSET (A, 195): DRAW CAR$πLINE (A - 2, 197)-(A + 17, 160), 0, BFπRETURNππSPEEDUP:πIF SPEED >= 15 THEN RETURNπSPEED = SPEED + .1πSOUNDLEVEL = SOUNDLEVEL + 10πRETURNπ πSPEEDDOWN:πIF SPEED <= 0 THEN RETURNπSPEED = SPEED - .1πSOUNDLEVEL = SOUNDLEVEL - 10πRETURNππ'Now THIS is the STUPID subroutine .π'I didn't want to complicate the program (for myself).π'So I copied the main subroutine once again and made the crash subroutine .π'NOW don't blame me ! I was new then remember ! I'm too lazy to change it now.ππCARCRASH:ππKEY(1) STOP: KEY(2) STOPππDOππLINE (100, 0)-(100, 200), 1: LINE (220, 0)-(220, 200), 1ππLINE (A - 30, B + 25)-(A + 30, B - 25), 0, BFππLINE (240, 10)-(260, 190), 1, BπLINE (240, 190 - TIMETAKEN * 9 / 10)-(260, 190), 2, BFππLINE (280, 10)-(300, 190), 2, BπLINE (280, 190 - (DISTANCE / 1000) * 5 * 9 / 10)-(300, 190), 1, BFππLINE (50, 50)-(75, 200), 1, BFπLINE (50, 200 - SPEED * 10)-(75, 200 - SPEED * 10), 2ππLINE (95, X)-(100, X - 95), 0, BFπLINE (95, Y)-(100, Y - 5), 0, BFπLINE (95, Z)-(100, Z - 95), 0, BFππLINE (220, X)-(225, X - 95), 0, BFπLINE (220, Y)-(225, Y - 10), 0, BFπLINE (220, Z)-(225, Z - 95), 0, BFππIF FINISH$ = "WIN" THEN LINE (100, FINISHLINE)-(220, FINISHLINE + 10), 0, BFππIF Z > 240 THEN Z = 0πIF Y > 240 THEN Y = 0πIF X > 240 THEN X = 0ππIF SPEED >= 0 THEN X = X + SPEED: Y = Y + SPEED: Z = Z + SPEED: SPEED = SPEED - .1πLINE (A + 5, 175)-(A + 15, 195), 0, BFππLINE (CARX, CARY)-(CARX + 20, CARY + 35), 0, BF: LINE (CARX + 5, CARY + 10)-(CARX + 15, CARY + 30), 0, BFπLINE (CARX + 5, CARY + 7)-(CARX + 15, CARY + 10), 0, BFππIF 50 - INT(DISTANCE / 1000) <= 0 THEN FINISH$ = "WIN"πIF 200 - TIMETAKEN = 0 THEN LOCATE 11, 16: PRINT "TIME UP": BEEP: SLEEP (2): STATUS$ = "LOSE": GOSUB PLAYAGAINπCARY = CARY - 3πDISTANCE = DISTANCE + SPEEDπSYSTEMTIME = INT(TIMER)πTIMETAKEN = SYSTEMTIME - STARTTIMEππLINE (95, X)-(100, X - 95), 1, BFπLINE (95, Y)-(100, Y - 5), 1, BFπLINE (95, Z)-(100, Z - 95), 1, BFππLINE (220, X)-(225, X - 95), 1, BFπLINE (220, Y)-(225, Y - 10), 1, BFπLINE (220, Z)-(225, Z - 95), 1, BFππIF FINISH$ = "WIN" THEN LINE (100, FINISHLINE)-(220, FINISHLINE + 10), 2, BFππ'Rotate carπDRAW "TA=" + VARPTR$(ANGLE)πPSET (A, B)πDRAW CAR$ππLINE (CARX, CARY)-(CARX + 20, CARY + 35), 1, BF: LINE (CARX + 5, CARY + 10)-(CARX + 15, CARY + 30), 2, BFπLINE (CARX + 5, CARY + 7)-(CARX + 15, CARY + 10), 0, BFππSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .01ππLOCATE 1, 1: PRINT "Speed :"; INT(SPEED * 10)πLOCATE 2, 1: PRINT "Crashes :"; CRASHπLOCATE 3, 1: PRINT "Kms :"; 40 - INT(DISTANCE / 1000)πLOCATE 4, 1: PRINT "Time :"; 200 - TIMETAKENπSOUND (SOUNDLEVEL), .03ππIF A > 190 THEN A = 190πIF A < 130 THEN A = 130ππ'Determine direction of spin and centre car if it spins out of roadπIF CARX <= A - 15 THEN ANGLE = ANGLE - SPEED ELSE ANGLE = ANGLE + SPEEDπB = B - SPEED * .05: IF ANGLE <= -360 OR ANGLE >= 355 THEN ANGLE = 0ππIF FINISHLINE >= 200 THEN GOSUB VICTORYπIF SPEED < 0 THEN SOUNDLEVEL = 440πSOUNDLEVEL = SOUNDLEVEL - 10ππLOOP UNTIL SPEED <= 0 AND CARY < -50πLOCATE 1, 1: PRINT "Speed : 0"πSLEEP (2)πSOUNDLEVEL = 1000πSPEED = 0: ANGLE = 0: B = 195: CLSπRETURNππVICTORY:πKEY(12) STOP: KEY(13) STOP: KEY(1) STOP: KEY(2) STOPππSPEED = 0πFOR I = 200 TO 0 STEP -1πLINE (A - 2, I)-(A + 17, I + 30), 0, BFπPSET (A, I): DRAW CAR$πSTARTIME = TIMERπDOπtime = TIMERπLOOP UNTIL time - STARTIME > .005ππNEXT IπCLSπCIRCLE (165, 85), 50, 1: PAINT (165, 85), 1πCIRCLE (160, 80), 50, 2: PAINT (160, 80), 2πLOCATE 10, 16: PRINT " YOU WIN !!":πPLAY "MFo3L8ED+ED+Eo2Bo3DCL2o2A": SLEEP (1)ππSYSTEMππPLAYAGAIN:π50 CLS : LOCATE 11, 13: INPUT "QUIT ?(Y/N)"; ANS$: ANS$ = UCASE$(ANS$)πIF ANS$ = "N" THENπCLSπIF STATUS$ = "LOSE" THEN GOTO 1 ELSE RETURNπEND IFπIF ANS$ = "Y" THENπSCREEN 2: SCREEN 0: CLSπLOCATE 10, 25: PRINT "This game was written in QuickBasic"πLOCATE 11, 22: PRINT "You are free to distribute it as you like."πLOCATE 12, 28: PRINT "Do send in comments at:"πLOCATE 13, 27: PRINT "avkumar@giasbm01.vsnl.net.in"ππLOCATE 15, 30: PRINT "Thanks for playing..."πDO: LOOP UNTIL INKEY$ <> ""πCLS : SYSTEMππELSE GOTO 50πEND IFπDavid Zohorb SOLO DOGFIGHTING www.wp.com/80948/qb/ 07-06-96 (00:00) QB, QBasic, PDS 115 7555 SOLO.BAS DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"SOLO.ZIP",4^6:Z&=5396:?STRING$(50,177);πU"%up()%9%%%R-%+PTfCuk*6fL(.%%^c%%%-%%%%xt%qtSgUx%fj<D=Lq19OjM^wIπU"Gnt3HCe&$J;QfQE#Rc)9QY,.9+ZGt-vp^j8/cS]lkTl>8:N_UVm#=Y(I<4e[k>]πU"#>$7kT/W>WJvSB6jjKcjX\GLq.:x(i&LJ]cm(.=Up+tmI;Vyca=DRqfhBg,#:2XπU"g3XV#YpXE]KIa;a'N)2j0u5e4$4m#Wf?j1O=/B$MkL,rmbsc\EGS1fe2*3M,\0jπU"8=xobPgKVHsD>TiJwf-BL12;;)q1KSXU_9?-FMRn0R<%]#9jW#ZW^0Wn>vLtBg\πU"gr)EA84q$VOCI#oZF?Sa<t]i]ZFHEirX(buJ-g_[=69HIR,o$R/A,HM;VotpV2VπU"1>7>2iH$^A0pGw5ptujkuNB&'bUbr#U\*k[^5b$VjdK%:tkK.s)YBSBXrGT*snNπU"FUGwLBVIe3hegYoTDCCg&J,cjaJi<C0kIk)tt8Y;MYl*c2QkrHAg4b:j:vf)mAdπU"Dm(1nL+js=w*V6dQZjLUV,V=(OO2Yg]$H/87995Wx]rRA9:S[a]uYa5X2aj(pLjπU"M#Tq.+bp\PkDJfr*lpn04/.B^8]QXh+UvKsF#^WSAtr?A'E47zLkoTuaNpV)xX6πU"cCP-?#y_E&:,m;PPG&LmbbV;1k_GsR4J>-zNlZ0vrS^s**E>^(Ydd(?oFzr*,,6πU"D#NWg.tD0E1TLfvh.;o6r+Nu%h.r+:g#eUZM.$hf*^eMcgXV720YdD#iQO'8U>6πU":EfoY]%PkR_d#*]q*^Hp:;)c<prAP<dFgr=/B_TV^):Ao*dkXgT45/tnXoT.f$;πU"Pr[yD#Y_cU)o^\0utB8k5ORu1^q?2Pq+jgz\_A\D0VA>.nNB2l.Hjpzle,eECHlπU"tc,j>4(8oQz'gsF<344YD0vq%:he:*,/--3-LWqM%H8Z^PxJkMl>wb5i\XYF5cnπU"ldK9*3n>gKr7$ntm6&P2NnCLa(U,dJ9,NSR^K=^o.[]TnoC9+n=OkPs,>Bt5%)fπU"5)%f5)f%5)f5%)f5)%f5)f%5)f5%)f5)%f5)fg5=f]uXIhu%+up(%)9%%[%-%qGπU"b_EB<X<CD[6%%d&2%%-%%%%x%tqtS[gfxfe+p>\<AEW#*iN]HI1UA*_EbjK2edmπU"kQU/K*DW<>aO?G+3Lh*;Z8<nMJsNTCXL?3j;PQe5f^zMrcQ:#x1)$Ir$]7f0NNgπU"IKDUCDcDn'jwksdx2rKhdEFbMrBscVDSIlXZvLmcyvsf:]OllYZzxpUYvba(usdπU"HxPDjlxw\l:D[u-;50i5f38oJf4*+2-\*#3#4&SQg5QG]ATNGQ?*xafoEOvG]d,πU"x(R&9odEwj)p4,wck:L=e,oL+E?Jm#H?dDq2p1cUXlqXEYW/lwTi'v$4gHH6DHLπU"h?2wRr)hN,K14KSbhsv7+t70Vl8eT[xT+hY/[s29?U^DtA9ff#RAe<s9#,OutpHπU"H<HV\E;GkH=PXpr/?[FU,:TIXYsse_tu8V6HZqtLpEpA]Y=L\SFfU-#$<,#YweHπU"GgE'hl5*6limNjVm'W1GgB2+iv]56&:G%,2k8JPLZH20q?IC7PCsvjAsFlU]80sπU"dN#hu<lWN1e2;vcahi:ung/?S\eJM<:5Q$NA2c3u=4exsFO8$PX,xBj<;La2HvqπU"5/LUAv^fJtAh]rHVcCDH;zlxX*mqnNXV/p9G,<_lp%gs0gp?Hpgbod(iY.saG30πU"v]ug6_6z&M6/mkg]V[?rF4t-<XUlSD+F,?TNbh+fu+RHelctwVtFOU6,gH#e=$RπU"H]VT(1EfD+RooZU-MJ&lMZ8L6UVZ-pYI6?K=-<b</TdV3+'5E1<cYW*l4=[$,Y2πU"pw$RZOd.KWY]'O$,K0o]+UFf\+[5I*zV*VZjoh4vc?R^agQ+fJEgergk0HIStJ<πU"raNr='%Z3GO4cJTWu6CZt4hgmss(H4q&l8/Y0I293pEFk+Xq:QBK'TX6JClPnWkπU"w%;M;eZMG[WwBpW#ZSg#>m8WruM(oPfw6^WljA5Cr9*#pTG)Fm$6E*(Q?5Q$&duπU"mE3LI%gZ')QWiG4veUTMDZBqBJjC\J(yOQE4ws7(JZ;2u6aw$?3<N;M#B^9/'$BπU"Djb1D#G^.Yn-iux=$t#aoQYG^0OAEV-=-LY^Ch(ADICqNXpFIoU+=u]PW-HZDR%πU"XPnC[7bGqo$%QlZ>RUu'ie:[U59G=St4$SnS4vK$uZQ2#?G<sbJeljSUMgP+/pBπU"ovtfXDM5)9XR1eEh>EFsk66EtC?]#/OY9sN)H6]B2kQ0Y<k?Ehbm,6_#=*RU*_*πU"MADf1qbSTOE#SY^W]Fs.a'7Hn49.x+/&D0;Ci(MWA*ZL=Fj];Wq,j%A/F<UyNM&πU"]VRBL\b4ihe[p:4f:%Vf^F>>1W[12(8jG&0aVhzKDU5YjV0r,[yCj4,YJH(t%?aπU"?ep-E^\'Zwdd:V(7q,Q*lUGb)O'i7Bvb9SN?XS:Q8$Axn5dY=lE+>(9uBIb8XXyπU"c'S:/[Mo:m5N).__tfS:zL02pqN-[e;Yvjz]Z2^VVzF25z/Yl,R*9pYfBU5cn9;πU"1ojT[0EK6.5o,9xU&7%YWs:N'.z,p3;2uZ,(kZ^n*<e=hI&m%,h0,4.apOz\=i?πU"QmmXXF:PgKOsFS<MiYlA4k:8loL3k=x12Ba1s</r,yRCj495Z&1z%*xe649-cmTπU"<Yk/+9PM>2O/7LsIHZS>(3)557](B4xFz=s[<%=V:To(_xlPemzeZ6PzOy]$5NPπU"'\zW%:Yy%*Ysz0:%<TR7DV5do(_xlPeZ.G3YE4T?AFq*Hu$6<BE;YLst-eppV'/πU")p%>Gh3;$?_,QU+gKoip;egDS-BRD+\7n^rAl/0<Qbl/GmN'*?(2x<b^aV>zR7UπU"H<%WjV0%(Oq(LF%M'Jdu#WB.bTujW'::l\Oa_r(&Dk2:ugmvI%h-CJYl<(/;no0πU"eZOssWm::KD/b[5EvlnSv$ui(>u2jMJ%$n>2iop?1uZ3vHRTVBjF,F$T1n3Y9QLπU"$wjs(f(L45iXsu;Sd7Vl2Qrq%\L9$1:GBg0*(Y\lQ&Q0uPPr*NFjcYf5^x[3INBπU"W<*B.\[L9$[.P-4FlW[+HJ6,3lTdf6FnL3h9aG?Ce8RN<;jOE;cM/#P)L'1QQUTπU"5lxTpaom$5#0q<j*$'7kXq%$]gB^&-(d1qtNo:?RVZeSi;xB=w[-yP35Rr3Vl79πU"f=YV)kTnTbAHiHZaYkg+IQCr$On9]PK$8isMx$kKa?sF<'J'NkFimNX#7O-*npiπU"'M3=x7sTW[e?NM>OxM:k%)^ocw<b$DR2cuAuSSe#9nJG9dksUlo^<[gu5llOLkGπU"9-wNuIt2GQlpEFOS46vSR[)=#h1]Ors4t3SmySRkNZv97\bC<5aESI80I>>8zoCπU"O&_G_w;Sa3^ZdWue2kr%B?4G_V,:g;z0,*$M7hZ+AmC6nl6_h+e,5]4D-:YBR=TπU"g0T*T6(]G2p6gMLZr_U<p7mEw'T2]P+wc#JZn($FLrF6onHGq$kP2\_9?&byJmOπU"&wq:[2A-we5rnD6.z4Cze&vUp:wsR'Fcw/59L6L&FDArvX*b9;JPa/t8iDQ-dl:πU"\%gCxwp>Qd6I'nk>d24U_O%wvR(iNsX%RON&I$l4%n\f+Q+ZF0Su_tb[[2]5+xCπU"m?trNF4'aM2^f0K&A:qKrq-lNKDs$dR:;lIuirT:IZgh3VQF>HD6wPF]sHnE_TqπU"fJcZq76/+k:TOY5[-+2Xrq.E'TfRo9)M8[,D%f:z%_*KM[(iRUtdsMUka;J+QVtπU"oJ[^Rx>Idimx8rVh2&*>lBXe(\?cg%k%;FFD[bAZb.UBkQP1*NhkRT?5$NKqZh6πU"8S=kmK1Hy3gia[a.JHgb&$IP;A8IHyD3sMh/to5nha(IBXQEWa#IP;8aI,yBi%qπU"3/(OhRnb5dJ,LVJ*aN%'s$$E%J,DZa^yD3]IhqrfE:]eBn+)1$kWUldE$(IbiqqπU"F.cKhVFRSFfD,s%vWA>H9Dkr_p[j5$eazOP,F1(Z3w+m4pxo:Z1%/=I.s9rIj=pπU"%]Uwa&Z%TLIl3jlpnQnp-hP=8f;L<f:2CbcAaS+s<barGZ]):'&_^;ZZP/,T*=kπU"W9<^nj?Kqu$K/,AS7rJrj:*3;h_M,qBpGdnWa_LVef7M7ox()1Y7,pzdQG,Y9,UπU"nlObLixb[8JC,,WaCv>kAQzgX:lu-Tdom:/(O%f1)(nO6#cg8Z690fzqcY?>S2jπU"XnMArr5[p9ee.U\0+^S#peLTH:tlTDs.']BMxOKXPaJ30y1ac9p[),2ZveQ$iL#πU"E?*Kfsq2tPXoHXhl7b$k3?5bnW/W7ue0l?pTYDU/[yxW/H3-lFC=Vl*jyiOe,/eπU"N'^B^:kWODF\K;7pu&F]jC%.'kV%mDfKV*8X4_1*pHK1it+m-9.&umON&)Ojp=pπU"J;9f&oY/=oJOw]-Vj42aqrw,C-9BOqJxq&g1Mlm?uAn.N>dp;6g[Q27oAhj1t%[πU"^>a+F-GHeeQw*V7B129v&Omsf5iSf\n:)hubX]9aVYaFiXn+V)2)O,WH0a</NZ-πU"5PUd\*+mKHu;e8KT5n0t(HuLm#EE5Zg<jSOQP8-M.<Y9fmxLGn&S>k5[MBXho-RπU"^$^8>?x/*]rXOO,8I0D=R/LM8]gB;'Q2oxC**E.JVm=_0'm60aw-jJ=8;;Nf/E*πU"R2Q;20QkV;pC]MiAcuKy:=;A4H5a\vP?KR;OrSqatG0Z9*q'*R;cS?;OkF,T[ocπU"7BN#rx**1ENem?'''mS6047VZq0ZJTx;0D>40Jp#*QXKF;YB7tI$cIr:;P(aGG^πU"Hp3Gl1RkqR53x-:js*T,JdRk<5;ZKTG*Y,Ika357^aa2m<Fn^R$A9/X1J:q]b-lπU"wNNRbeq?Gbw)k:&&tWRn/o;wERob3_PJM59bDTNK(xPERs>W_bw5V9*dyk<6uSPπU"4lzhQH(jxk<(z/Nvi9f1r45chd<u/u,'SGM:x\mr:,oTeiL?Eer.uku-8em+A.NπU"c.m\b,8D>BIE+n^F+xhJk/V$)_=D9GDlHYboja7^YHh9sn%Myz]K;c)$l(.VHO]πU"rdW-Yg#J-%u50Q^gO8(Kf(5Gsm'P:Ox_]j6B'$90,Y%'K0*y-QEQ;L_Lb\1vsxcπU",1G+faSh&5cA'Zc$37I]Z#,ahLbd/pXu-qwM_,<TN[qkqBKTscK[g.e*ES[1d?iπU"ABMtG+$Nvs\QDu+?5JoB4gs=hv%+xbnn_ExI/eK=q#]*6rP(RM1V$T:nfT+4nW/πU".&8z^pvw#Yv6[7>Vx04k]Q_j6M#Ktqhnx%c#aI$*<J-x:JXeprHFMO)*eSx+13bπU"NK<kb?#[e?HKHs=H/YNHNMHqaFheb6pCZ&I>Px]^e)b6\Te&IN58k?8+E1SqBI^πU">#B>>.7vdjl+/G**X&R6o'QT']aesvKEC)zHB>QF&k^UqknKF5F%+gcg&iFN/xYπU"_;w9R:kx^CE<Eo(I#O4<PrMANe/$tep2d+0Uv9r=JN$tkL2dA%1zY<h;.18zT5:πU">fNR3b,gtFQoMm/_,E=7fI-P/*0BnyI,+:JB]bClxUujUV:AF1GChPb6Mki.1DsπU"T842$eAgoRhL+(LyJ8;3RTToVYx$T]C7p^1\^D#O[n]RS77k,_j3HrIP?3(PR&;πU"PBk+^)TKEC<'QZ#)b.$Av(^litLW<4+eichUqojQxX,&++eTRICC?UM>R:e&aWgπU"YI(i+hnBo$lBr,\DjP9Rl.IT#i7H\Qym0#M7,q'\e5,]+K,^uEWEH'eV,0t#)O]πU"VokZj]r>c_\/H3o/iAcX\LXdL]#AA=N:(RRH)v$3Tt7PjYJU5AapcikmWJH)BcuπU"NNmfefZ'><'UZHk:ytA%1#u(+MUHT#aHT\Jh,=U&rblvVlmIQHLF5RVasH\%$B^πU")NB\3w3=#V21EX#VIk7Q,A,7F?<Hm7]W?[/Zm(QXvTV0[A)2LU94%/EG2h+Y$N+πU"'tiwF,27I7n;$)sKMcj,y.dWod>7XY0cl[c40<S1#X+3UFTW$6TG)eC3t>H1e'JπU"?xy<8p:L,)eWJ&2KA[oMs[fQ&+%+gv'bXOT0%_ke08.o1jbm5>^s$Q/]2WUL(E7πU"esFLLbvo#t2c8CDDS-093x_;dbbK1=H8H]AsH1l5.NzJ;s+<2q;g7i:W'Qbr$0OπU"tl3AnIvqC'Dc5Dqvw3:jM0F;WuKN7bLLT-&gC7-Sx[P<eT-a9LwoSHzo4Y*w>*BπU"o&uFgC^Q)_$bp7\,Pcs)(n+Up1uu,K/5IN5jtp\EUR]7oNyjHisRkAcvt%G0VLNπU"-AN2k0M?ff'9#l#l6iB,aa,:UHW7?<X1dLWNYjHwGRAZYyTL%48P(GPD\3A:Qr*πU">mkatF367n5*;U7.e4>iLSh]XBDEq6?f2sFUs\UFKo+6o6'\;UILYuoe\\F(#^9πU"[C;MXDS-9Pp0^W[5?BVUYJf:f*WDWH$)r%w:Oni3gcKSmoJ[d?cL-#T^+JQ#$VZπU"Nc?r_gs0Jbx$j+5RmKNWX[hrHOv?pj;q7UC7Iu(8)04y-O*/Idu-cq^ZWo26$wFπU"qQ+f,7hEnmyXd5$_z_3/HQhvpj.gdK$Axb3P%L(OVpdH&^9PJ2B7fSYQ]H'C)H>πU"0eZA*G%m//^,8/E70-kMbh1NN%VGj&G=dO4DWd,nI^LH0xmt[:a:Rv0ddJ9SvigπU"j/gU<LrSu%xe\sBEXJu]x<K_dek/*w.up%&'9%%9%%%R-%+PTfCuk*6fL(.%%^cπU"%%%-%%%%%%%%%%%%E%%%%%%%%%xtqt#Sgx%%up&'%9%9%%%%-%<qb_EkBX<C%D6πU"%%*d2%%%-%%%%%%%%%&%E%%%%r(%%%xt%qtSg%fxup%*+%%%%%'%.'%;%.%%a9%πU"%%%%πEND SUBπCLOSE:IF S=135AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπSteven Hanov LEAPGUY hanov@wchat.on.ca 06-12-96 (00:00) QB, QBasic, PDS 809 31246 LEAPGUY.BAS '****************************************************************************π'* IDENTIFICATION *π'* *π'* NAME: Steven Hanov (hanovs@wchat.on.ca) *π'* PROGRAM: a:\class.bas * *π'* SCHOOL: Cardinal Newman C. S. S. *π'* TEACHER: The teacher formerly known as Mrs. Gotovac. *π'* COMPUTER: IBM/MS-DOS *π'* LANGUAGE: QBASIC *π'* PLANET: Earth (Sol-III) *π'* PERIOD: LATE 20th CENTURY (Gregorian Calender) *π'* CLASS: DPT 3A1 Period 2 *π'* DATE: 96/06/12 *π'* *π'****************************************************************************ππ'****************************************************************************π'* PROGRAM ANALYSIS *π'* *π'* In the 1980s, when the dinosaurs ruled the earth, we all used computers *π'* like the Commodore 64. It was great for games, and one game I liked was *π'* JUMPMAN (By EPYX MegaGames). This program is a re-creation of what I *π'* remember of the game. It has four levels, and is not entirely accurate. *π'* However, it presented a unique programming challenge that I was not *π'* entirely confident that I could meet. But after many hours of work, both *π'* in and out of class, the project is finally completed. *π'* *π'* The object of the game is to pick up all of the brown "bombs". *π'* Occasionally, white SmartDarts will fire at you from the sides of the *π'* screen. To move, make sure the numeric keypad is ON. The controls are *π'* on the keypad, and should be obvious. 8, 6, 2, and 4 move up, right, *π'* down, and left, respectively. 7 and 8, and 9 are also used to jump. *π'* *π'* One problem I had was speed; on a slow computer the character moves *π'* fine, but on a fast computer the gameplay is impossible. I surmounted *π'* this difficulty with the speed option in the introductory screen. *π'* On the school's computers, a value of one to three should be used. This *π'* value is used to control the speed of both the character and the *π'* SmartDart. *π'* *π'* Enjoy! *π'* *π'****************************************************************************πDECLARE SUB HighScores ()πDECLARE SUB paldef (c!, r!, g!, B!)πDECLARE SUB ClearKeyBuffer (n!)πDECLARE SUB centre (y!, t$)πDECLARE SUB UpdateScore ()πDECLARE SUB Die ()πDECLARE SUB Bullet ()πDECLARE SUB pandisplay (xp!, yp!)πDECLARE SUB DrawGuy (x!, y!)π'****************************************************************************π'* VARIABLE DICTIONARY *π'****************************************************************************πDIM SHARED graph(1000), pf(40, 25) AS STRING, sndπDIM SHARED bgraph(100), x, y, xx, xy, DontDraw, lives, dead, bombs, PointsπDIM SHARED DartSpeed, GuySpeed, Delay, ResetFlag, BonusπDIM SHARED Score(15), Name$(15), TotalScore, FileName$ππ'NAME ***** DESCRIPTION ************************************************π'graph() The image of the background behind the character is storedπ' in here, using the GET and PUT graphics commands.π'bgraph() Likewise, but with the bullet.π'pf(x,y) The current level is stored in here using the symbols explainedπ' in the data statements.π'x,y The current co-ordinate on the screen, in 8x8 units. The screenπ' is 40 units horizontally and 25 vertically.π'xx, xy The true, pixel co-ordinate on the screen. Range: 320,200π'DontDraw A flag for the DrawGuy sub telling it not to call the Bullet subπ'lives Self explanatoryπ'dead A flag that lets the main program know if the bullet hasπ' contacted the player.π'bombs The number of bombs remaining on the playing field.π'points The number of bombs the player has picked up. Whenever it'sπ' displayed, its multiplied by 100. The points are reset wheneverπ' the player dies to make it more challenging.π'GuySpeed Used in the DrawGuy sub in a delay loop to slow it down.π'DartSpeed Derived from DrawGuy. Controls dart speed.π'Delay This flag tells the bullet sub not to delay because it isπ' being called by the DrawGuy sub, which has already delayed.π' This makes the two objects move at the same time more smoothly.π'ResetFlag Tells the DrawGuy and Bullet subs to re-GET the backgroundπ' that they're on (into the GRAPH and BGRAPH) on a level changeπ' or else they'd draw a chunk of the old level on the new one.π'Bonus Contains the time bonus remaining for the level.π'TotalScore Contains the total score in the game divided by 100.π'Score()π'Name$() Used to read and sort the high scores from diskπ'FileName$ The name and location of the score file.ππ'****************************************************************************π'* MAIN *π'****************************************************************************πRANDOMIZE TIMERπKEY 15, CHR$(0) + CHR$(1) 'Defines Key# 15 = Escπ'ON KEY(15) GOSUB Ending 'ANYTIME user hits escape, gosub Ending.πON TIMER(10) GOSUB DecrementBonus 'Sets up the timer - Every ten seconds,π 'you loose 100 time bonus.πTIMER OFF 'But not right now.πKEY(15) ONπlives = 6πsnd = 1 'Clicking sound on movement ONπrt$ = "6" 'Define RIGHT keyπlt$ = "4" 'LEFT keyπUP$ = "8" 'UP keyπdn$ = "2" 'DOWN keyπDelay = 1 'Delay on call bullet sub.πFileName$ = "SCORES.DAT"πSCREEN 13πππy = 0: x = 0πFOR s = 1 TO 25π READ l$π x = 0π FOR d = 1 TO 40π a$ = MID$(l$, d, 1)π IF a$ = "W" THEN 'Displays in the introductory screenπ c = 15 'graphic, which is stored in DATA.π ELSEIF a$ = "R" THEN 'It looks just like the old C=64 game!π c = 4π ELSEIF a$ = "M" THENπ c = 5 'R=RED square, M=magenta, C=cyan,π ELSEIF a$ = "C" THEN 'Y=yellow, G=Green,B=Blueπ c = 3π ELSEIF a$ = "Y" THENπ c = 14π ELSEIF a$ = "G" THENπ c = 2π ELSEIF a$ = "B" THENπ c = 1π ELSEπ c = 0π END IFπ LINE (x, y)-(x + 7, y + 7), c, BFπ x = x + 8π NEXTπ y = y + 8πNEXTπππWHILE INKEY$ = "": WEND 'Wait for keypressπCALL HighScores 'Display HighScoresπPLAY "mbt128 O3 C16 O1 c16"πCLSπCOLOR 3πcentre 2, "LeapGuy"πcentre 4, "By Steven Hanov"πLOCATE 6: PRINTπCOLOR 5πPRINT " Movement:"πCOLOR 14πPRINT " 7 8 9 Make sure your numlock"πPRINT " key is ON. Use 7, 8, "πPRINT " 4 6 and 9 to jump left, up,"πPRINT " or right."πPRINT " 2 "πLOCATE 19: COLOR 2πPRINT "Choose a speed for LeapGuy,"πPRINT "from 0 (fast) to 15 (slow):";πINPUT "", GuySpeedπ'IF GuySpeed = 0 THEN GuySpeed = 8πGuySpeed = GuySpeed * 100πDartSpeed = GuySpeed \ 25πIF DartSpeed = 0 THEN DartSpeed = 10ππNextLevel:πFOR y = 1 TO 25 'Reads in the next level from DATAπ READ l$ 'and stores in pf(x,y)π IF l$ = "STOP" THEN GOTO YouWon 'UNLESS there are no more levels.π FOR x = 1 TO 40π pf(x, y) = MID$(l$, x, 1)π NEXTπNEXTπREAD OriginalX, OriginalY 'Starting position for JumpGuyπClearKeyBuffer 15 'A sub that stops a really annoying problem.πBonus = 1000ππReDraw:πIF lives = 0 THEN 'IF the user has no life,π TIMER OFF 'Don't decrement the bonus anymore...π PLAY "T128 MB O1 L4 c2 e2 g2 >c1"π seconds = TIMERπ WHILE TIMER - seconds < 4 'Flash screen red and white forπ pandisplay 1, 0 'four seconds.π paldef 2, 63, 63, 63π FOR d = 1 TO 100: NEXTπ pandisplay 0, 0 'AND a cool earthquake effectπ paldef 2, 32, 0, 0 'with an OUT call I got from the 'Netπ FOR d = 1 TO 100: NEXTπ WENDπ paldef 2, 0, 32, 0 'Turn colour 2 from red to back to greenπ PLAY "MBO3 C8 <G8 >C8 <G8 A#8 F8 A#8 F8"π PLAY "G#8 D#8 G#8 MN G8 G#16 G"π CALL HighScoresπ ENDπEND IFπx = 0: y = 0 'BUT if the user has a life, they can play...πbombs = 0πdead = 0πDelay = 1πCLSπFOR s = 1 TO 25 'Redraws the level stored in pf(x,y)π FOR d = 1 TO LEN(l$)π a$ = pf(d, s) 'YES, it is declared as a string...π IF a$ = "=" THEN 'The girder/π LINE (x, y)-(x + 8, y), 2π LINE (x, y + 4)-(x + 8, y + 4), 2π LINE (x + 2, y)-(x + 2, y + 4), 2π LINE (x + 6, y)-(x + 6, y + 4), 2π ELSEIF a$ = "#" THEN 'The ladder.π LINE (x - 4, y)-(x - 3, y + 8), 1, BFπ LINE (x - 4, y + 4)-(x + 12, y + 5), 1, BFπ LINE (x + 12, y)-(x + 11, y + 8), 1, BFπ ELSEIF a$ = "+" THEN 'The ropeπ LINE (x + 2, y)-(x + 3, y + 1), 2, BFπ LINE (x + 4, y + 2)-(x + 5, y + 3), 2, BFπ LINE (x + 2, y + 4)-(x + 3, y + 5), 2, BFπ LINE (x + 4, y + 6)-(x + 5, y + 7), 2, BFπ ELSEIF a$ = "o" THEN 'The bombπ CIRCLE (x + 4, y + 4), 2, 6π bombs = bombs + 1π END IFπ x = x + 8π NEXTπ x = 0π y = y + 8πNEXTπLINE (0, 290)-(320, 290), 5 'A line that won't show up I know not whyπππReStart:πPoints = 0πx = OriginalXπy = OriginalYπxx = x * 8πxy = y * 8πFOR s = 440 TO 600 STEP 10π SOUND s, 1πNEXTπResetFlag = 1πCALL DrawGuy(xx, xy) 'Displays guy for first timeπResetFlag = 0πTIMER ON 'Turn on decrement time bonus eventπCALL UpdateScoreππDOπ a$ = ""π snd = 1 'Click sound on (movement)π IF jump = 0 THEN 'If not in the middle of a jump,π ClearKeyBuffer 5 'Clear keyboard buffer,π DOπ a$ = INKEY$ 'Get the keypress,π CALL Bullet 'Move the bullet,π IF dead = 1 THEN GOTO ReDraw 'If the bullet killed you.π LOOP UNTIL a$ = rt$ OR a$ = lt$ OR a$ = UP$ OR a$ = dn$ OR a$ = "4" OR a$ = "6" OR a$ = "7" OR a$ = "9" OR a$ = "N" OR a$ = CHR$(27)π END IFπ IF jump = 2 THEN jump = 0 'Just finished a whole jump.π IF a$ = rt$ AND x < 39 THEN 'Move right, don't go off edge.π FOR s = 1 TO 8π xx = xx + 1π CALL DrawGuy(xx, xy)π NEXTπ x = x + 1π ELSEIF a$ = lt$ AND x > 2 THEN 'Move left, don't go off edgeπ FOR s = 1 TO 8π xx = xx - 1π CALL DrawGuy(xx, xy)π NEXTπ x = x - 1π ELSEIF a$ = UP$ AND pf(x, y) = "#" THEN 'The user is on a ladder, soπ FOR s = 1 TO 8 'move UP, (NOt JUMP) when theyπ xy = xy - 1 'press 8.π CALL DrawGuy(xx, xy)π NEXTπ y = y - 1π ELSEIF a$ = dn$ AND pf(x, y + 1) = "#" THEN 'Go down a ladder.π FOR s = 1 TO 8π xy = xy + 1π CALL DrawGuy(xx, xy)π NEXTπ y = y + 1π END IFπ IF pf(x, y) = "#" THEN jump = 0 'If they jumped onto a ladder,π IF pf(x, y) = "=" THEN 'Stop the jump.π FOR s = 1 TO 8π xy = xy - 1 'If they're right OVER a girder,π CALL DrawGuy(xx, xy) 'Climb on top of it.π NEXTπ y = y - 1π jump = 0 'And stop jump that your in middle ofπ ELSEIF pf(x, y + 1) = " " AND jump = 0 AND pf(x, y) <> "#" THENπ fell = 0 'If you're standing on air,π FOR d = 1 TO 2π IF pf(x, y + 1) <> " " THEN EXIT FORπ snd = 0π FOR s = 1 TO 8 'Fall up to two units.π xy = xy + 1π CALL DrawGuy(xx, xy)π NEXTπ snd = 1π y = y + 1π fell = fell + 1π NEXTπ IF pf(x, y + 1) = " " AND fell = 2 THENπ CALL Die 'If you fell two units, and youπ GOTO ReDraw 'STILL haven't landed, you're out ofπ END IF 'luck.π ELSEIF pf(x, y) = "+" OR pf(x, y - 1) = "+" THENπ FOR s = 1 TO 8 'If you're legs or torso is on aπ xy = xy - 1 'rope, climb it.π CALL DrawGuy(xx, xy)π NEXTπ y = y - 1π jump = 2π ELSEIF pf(x, y) = "o" OR pf(x, y - 1) = "o" THEN 'On a bomb?π PUT (xx - 8, xy - 16), graph, PSET 'Erase Jumpmanπ IF pf(x, y) = "o" THENπ pf(x, y) = " " 'Get the bomb if under legsπ LINE (xx - 8, xy - 8)-(xx, xy - 1), 0, BF 'Erase bombπ ELSE 'OR ELSE:π pf(x, y - 1) = " " 'Get if under torsoπ LINE (xx - 16, xy - 16)-(xx - 8, xy - 8), 0, BF 'erase itπ 'LINE (xx - 8, xy - 16)-(xx, xy - 1), 0, BFπ END IFπ PLAY "t128 mb o1 l32 c o4 ccc" 'Sound effectπ LINE (xx - 8, xy - 16)-(xx, xy - 1), 0, BFπ GET (xx - 8, xy - 16)-(xx + 7, xy - 1), graph 'Stores new image,π CALL DrawGuy(xx, xy) 'without the bombπ Points = Points + 1 'Draw guy on top, increaseπ CALL UpdateScore 'points, and display new pointsπ END IFπ IF jump = 1 THEN 'If the user's in apex of a jump,π IF x < 38 AND x > 2 THEN 'And they're not in danger of passing edge,π snd = 0 'Turn movement click sound flag offπ FOR s = 1 TO 8π xy = xy + 2 'Jump back down to earthπ xx = xx + xstepπ CALL DrawGuy(xx, xy)π NEXTπ y = y + 2π x = x + xstepπ snd = 0π END IFπ jump = 2 'Completed jump cycleπ END IFπ IF (a$ = UP$ OR a$ = "7" OR a$ = "9") AND pf(x, y) <> "#" THEN 'Jump.π IF a$ = "9" AND x < 38 THEN 'Jump RIGHT.π xstep = 2π ELSEIF a$ = "7" AND x > 2 THEN 'Jump LEFTπ xstep = -2π max = 2π ELSEπ xstep = 0 'Jump UP.π END IFπ PLAY "MBT128L32ML o3 CEG>C<GEC"π snd = 0π FOR s = 1 TO 4π xy = xy - 2 'Preform exactly 1/4 the jump.π xx = xx + xstepπ CALL DrawGuy(xx, xy)π NEXTπ y = y - 1π FOR s = 1 TO 4 'The next quarterπ xy = xy - 2π xx = xx + xstepπ CALL DrawGuy(xx, xy)π NEXTπ y = y - 1π x = x + xstepπ snd = 1π jump = 1π END IFπ IF Points = bombs THEN EXIT DO 'You've won the level.π IF a$ = "N" THEN EXIT DO 'THE SECRET ****CHEAT CODE******π IF dead = 1 THEN GOTO ReDraw 'Restart the level.π IF a$ = CHR$(27) THEN GOTO EndingπLOOPπPlayTunes: 'At this point, you've passed level.πa = INT(RND * 3)πTotalScore = TotalScore + Points + BonusπPLAY "MF"πSELECT CASE aπ CASE 0 'Picks one of these congratualatory themes.π PLAY "O3T128MN L4C <G8 >C< G8 F8 G8 E16 F16 G16 A16 B16 >C16 D16 C1"π CASE 1π PLAY "O2 L4MN T200 C<G >C< G >C<G C G >L8 GF#G G# G G# A A# A A# B >C<G>C2"π CASE 2π PLAY "O2 L4MN MBT200MN C8 D# G8 >C< A#. G2 D#8 F D#8 F# A#2 F#8 F8 D#8 C8 <A#8 >C1"πEND SELECTπGOTO NextLevelππYouWon: 'The level re-drawer will send computer here if no more levels.πTIMER OFF 'Can you smell the meatballs in this plate of spaghetti? :-)πCLSπCOLOR 15πClearKeyBuffer 15πcentre 12, "*** YOU WON ***"πWHILE INKEY$ = "": WENDπCALL HighScoresπENDππ'****************************************************************************π'* SUBROUTINES *π'****************************************************************************πDecrementBonus:πIF Bonus > 0 THEN 'This sub gets called every 10 seconds duringπ Bonus = Bonus - 100 'game play (See help on "ON TIMER()" command)π SOUND 440, 1π CALL UpdateScore 'Decrements time bonusπEND IFπRETURNππEnding:πCLSπCOLOR 14πcentre 12, CHR$(2) + " Buh-Bye! " + CHR$(2)πENDπRETURNππCreateNewFile:πCLOSE 1 'Gets called by Highscores if scorefile doesn'tπOPEN FileName$ FOR OUTPUT AS 1 'exist.πFOR s = 1 TO 15π PRINT #1, "------------" 'This creates a new fileπ PRINT #1, 0πNEXTπCLOSE 1πRESUME 'And resumes where the "FILE NOT FOUND"π 'error occured.ππ'This following is the intro-screen graphic.πDATA " CCC C CC CC CCCC CC CC CC C C"πDATA " C C C C C C C C C C C C C CC C"πDATA "C C C C C C CCCC C C CCCC C CC"πDATA " CC CCC C C C C C C C C C"πDATA " "πDATA " BBBBBBBBBBBB "πDATA " WWWW BB BB "πDATA " WWWW WW BB BB "πDATA " RRRRRRRRRR BB BB "πDATA " RR RRRR BBBBBBBBBBBB "πDATA " WW RRRR BB BB "πDATA " MMMM BB BB "πDATA " MMMMMMMMMM BB BB "πDATA " MM MM BBBBBBBBBBBB "πDATA " WW WWWW BB BB "πDATA " YYYY BB BB "πDATA " YYYY BB BB "πDATA " BBBBBBBBBBBB "πDATA " BB BB "πDATA " GGGGGGGGGGGGGGGGGGGGBBGGGGGGGGBB "πDATA " GG GG GG GG GG BB GG GGBB "πDATA " GGGGGGGGGGGGGGGGGGGGBBBBBBBBBBBB "πDATA " "πDATA " "πDATA " "ππ'The following are the levels. After each is the staring x,y position.π' It is possible to add more before the "STOP". Each is 25 lines.πππ' 1234567890123456789012345678901234567890πDATA " "πDATA " "πDATA " "πDATA " o o o o "πDATA " ==#=== ==== o o ==== ====#== "πDATA " # # # "πDATA " # ====#==== # "πDATA " # o # o # "πDATA " # ==== # ==== # "πDATA " # ======#===== # "πDATA " o # o # o # o "πDATA " # # # "πDATA " # # # # # "πDATA " ==== === ==#=======#== === ==== "πDATA " + # # + "πDATA " + # # + "πDATA " # # "πDATA " # =================== # "πDATA " ==#======= ========#== "πDATA " # # "πDATA " # o o # "πDATA " # # "πDATA " o # ======= # o "πDATA " ====================================== "πDATA " "πDATA 20,17ππDATA " "πDATA " "πDATA " "πDATA " o o "πDATA " # o =========#========= o # "πDATA " #==== # ======# "πDATA " # === # # # === # "πDATA " # ====#==============#==== # "πDATA " # # # # "πDATA " # o # # o # o # "πDATA " === =#=============================# "πDATA " # # "πDATA " # # "πDATA " # # "πDATA " # # o # o # "πDATA " #============= =======#========= "πDATA " # # "πDATA " # # # "πDATA " #=============== ==#========# "πDATA " # === # # "πDATA " # === # # "πDATA " # o === o # # "πDATA " ====== ========= === "πDATA " "πDATA " "πDATA 37,22ππDATA " "πDATA " "πDATA " "πDATA " "πDATA " o # o o # o "πDATA " ===========#===== ======#=========== "πDATA " # # "πDATA " # # "πDATA " o # # # o "πDATA " === ======= ===#== ======= === "πDATA " + # + "πDATA " + # + "πDATA " + # o # o # + "πDATA " + =#======== ===== =======#= + "πDATA " + # o o # + "πDATA " + # # + "πDATA " + # # + "πDATA " + # # # # + "πDATA " + ===========#======#=========== + "πDATA " + # # + "πDATA " o # # o "πDATA " o # # o "πDATA " ====================================== "πDATA " "πDATA " "πDATA 21,13ππDATA " "πDATA " "πDATA " "πDATA " o o o o "πDATA " =#======== ==== ==== =========#= "πDATA " # # "πDATA " # # "πDATA " # o o # # "πDATA " ======== ==================#======== "πDATA " + == # "πDATA " == # "πDATA " o == o # o # o "πDATA " ==================#=================== "πDATA " + # + "πDATA " # "πDATA " o o # o o "πDATA " ======== =======#======== ======== "πDATA " + # + "πDATA " + o # o + "πDATA " + === ========#========= === + "πDATA " + # + "πDATA " + # + "πDATA " +o # o+ "πDATA " ====================================== "πDATA " "πDATA 20,12πDATA "STOP"ππSUB BulletπSTATIC B, PrevX, PrevY, xtep, ytep, px, py, elapsed, DontChaseπIF Delay = 1 THEN 'If the sub is being not being called by theπ 'DrawGuy sub, there is no delay so it'llπ 'have to delay itself.π elapsed = elapsed + 1 'Does so by only executing every 25th CALLπ IF elapsed < DartSpeed THEN 'or so.π EXIT SUBπ ELSEπ elapsed = 0π END IFπEND IFπIF ResetFlag = 1 THEN B = 0 'Player has started new level. RereadπIF B = 0 OR dead = 1 THEN 'The background or if first time called.π IF INT(RND * 500) <> 99 THEN EXIT SUB 'Makes bullets come OCCASIONALLYπ elapsed = 0 'NOt one after another.π DontChase = 0π B = 1π a = INT(RND * 2) 'Come from top or left side?π IF a = 0 THEN 'If side,π px = 2π py = INT(RND * 180) + 2π xtep = .2 'Y step value,π ytep = 0 'X step valueπ ELSEπ px = INT(RND * 290) + 2 'If top....π py = 2π xtep = 0π ytep = .2π END IFπ PrevX = pxπ PrevY = pyπ GET (px, py)-(px + 1, py + 1), bgraph 'Gets background behind bulletπEND IF 'so it doesn't erase what's behind.πpx = px + xtep 'Move it horiz or vert..πpy = py + ytepπPUT (PrevX, PrevY), bgraph, PSET 'Erase bullet and put back what was there.πPrevX = px 'The previous position saved for the nextπPrevY = py 'time.πGET (px, py)-(px + 1, py + 1), bgraph 'Saves background again.πLINE (px, py)-(px + 1, py + 1), 15, B 'Draws bulletπcx = px \ 8 + 1 'Calculates the "text" (8x8) positionπcy = py \ 8 + 1 'of the bulletπIF cx = x AND cy = y THEN 'If same as guy's position, smite him.π CALL Dieπ EXIT SUBπEND IFπIF x < cx OR y < cy THEN d = -1 'IF the bullet is on same line asπIF y > cy OR x > cx THEN d = 1 'guy, AND it has not already changedπIF cx = x AND DontChase = 0 THEN 'course, swerve directly to him.π ytep = dπ xtep = 0π DontChase = 1 'But it can only do it once.πSOUND 400, 1: SOUND 1000, 1πEND IFπIF cy = y AND DontChase = 0 THEN 'Same, but for vertically.π ytep = 0π xtep = dπ DontChase = 1πSOUND 400, 1: SOUND 1000, 1πEND IFπIF PrevX > 290 OR PrevY > 180 OR PrevX < 2 OR PrevY < 2 THENπ PUT (PrevX, PrevY), bgraph, PSETπ PrevX = 0π PrevY = 0 'If offscreen, erase everything andπ px = 0 'prepare to start a new instance of theπ py = 0 'bullet on the next call. (B=0)π B = 0πEND IFπEND SUBππSUB centre (y, t$)π'Centres something on the screen at the line YππLOCATE y, 20 - LEN(t$) / 2πPRINT t$;πππEND SUBππSUB ClearKeyBuffer (n)ππ'Clears the keyboard buffer by repeatedly reading in keys.ππFOR s = 1 TO nπ a$ = INKEY$πNEXTππEND SUBππSUB Dieπ π DontDraw = 1 'Stop the bullet movement (in DrawGuy calls)π snd = 0 'No click sound on movement.π FOR i = xy TO 200 STEP 3π CALL DrawGuy(xx, i) 'Make him fall.π SOUND 400 + (200 - i), .4π NEXTπ snd = 1π SLEEP 1π DontDraw = 0π PLAY "t200o3 MF MN L4 c2ccc2d#ddcc<b>c"π lives = lives - 1π dead = 1 'Set death flagπ πEND SUBππSUB DrawGuy (x, y)πSTATIC a, B, PrevX, PrevYπFOR s = 1 TO GuySpeed: NEXT 'Delays for fast computers.πIF ResetFlag = 1 THEN B = 0 'If next level reread backgroundπpx = x - 8πpy = y - 16πIF B = 0 THEN 'If first time called, read backgroundπ B = 1 'behind the guy with GET so he doesn't erase itπ PrevX = px 'or leave trails.π PrevY = pyπ GET (px, py)-(px + 15, py + 15), graphπEND IFπPUT (PrevX, PrevY), graph, PSET 'Put background back, erase guyπPrevX = pxπPrevY = pyπGET (px, py)-(px + 15, py + 15), graph 'Get background at next positionπa = a + .5 'Move legsπIF a = 4 THEN a = 0πLINE (px + 3, py)-(px + 5, py + 2), 15, BFπLINE (px + 2, py + 3)-(px + 6, py + 6), 4, BF 'Draws guyπLINE (px + 4, py + 6)-(px + 4 - a, py + 13), 5πLINE (px + 4, py + 5)-(px + 5 + a, py + 13), 5πLINE (px + 4 - a, py + 14)-(px + 4 - a + 1, py + 15), 15, BFπLINE (px + 4, py + 14)-(px + 5 + a + 1, py + 15), 15, BFππIF DontDraw = 0 THENπ Delay = 0 'Calls the bullet sub and tells it not to delayπ CALL Bullet 'because we've already delayed.π Delay = 1πEND IFππIF snd = 1 THEN SOUND 10000, .1 'The infamous click sound.πππEND SUBππSUB HighScoresπON ERROR GOTO CreateNewFile 'If file doesn't exist, branch there.πCLSππOPEN FileName$ FOR INPUT AS 1πON ERROR GOTO 0πFOR s = 1 TO 15π INPUT #1, Name$(s) 'REad in scoresπ INPUT #1, Score(s)πNEXTπCLOSE 1πFOR outside = 1 TO 15π FOR inside = outside + 1 TO 15 'A bubble sort, just for you,π IF Score(outside) < Score(inside) THEN 'Mrs. Gotovac.π SWAP Score(outside), Score(inside)π SWAP Name$(outside), Name$(inside)π END IFπ NEXTπNEXTπππPLAY "T128 O2 L4 MS MB G8>C8 G8 G8 <G8>C8 G8 G8 <G8>C8 D16 E16 F8 E16 D16 C2"πCOLOR 14πcentre 2, "High Scores"πCOLOR 3πPRINT : PRINTπFOR s = 1 TO 15π LOCATE s + 3, 10π PRINT Name$(s); TAB(22); Score(s); " "πNEXTπLINE (68, 4)-(236, 144), 4, BπLINE (68, 20)-(236, 20), 4πClearKeyBuffer 15πIF TotalScore * 100 > Score(1) THENπ COLOR 14π centre 20, CHR$(2) + " NEW HIGH SCORE " + CHR$(2)π PRINTπ INPUT "Please enter your name: ", n$π n$ = LEFT$(n$, 12)π FOR s = 14 TO 1 STEP -1π Name$(s + 1) = Name$(s)π Score(s + 1) = Score(s)π NEXTπ Name$(1) = n$π Score(1) = TotalScore * 100π OPEN FileName$ FOR OUTPUT AS 1π FOR s = 1 TO 15π LOCATE s + 3, 10π PRINT Name$(s); TAB(22); Score(s); " "π PRINT #1, Name$(s)π PRINT #1, Score(s)π NEXTπ LINE (68, 4)-(236, 144), 4, Bπ CLOSE 1πEND IFπππππWHILE INKEY$ = "": WENDππEND SUBππSUB paldef (c, r, g, B)π 'Redefines a colour to be another custom colour.π π OUT &H3C8, cπ OUT &H3C9, rπ OUT &H3C9, gπ OUT &H3C9, BππEND SUBππSUB pandisplay (xp, yp)π'Makes the display instantly jump for earthquake effect.ππOUT &H3D4, 12: OUT &H3D5, ypπOUT &H3D4, 13: OUT &H3D5, xpπEND SUBππSUB UpdateScoreππ'Updates the scoreboard.ππLOCATE 25, 1πCOLOR 2: PRINT "Lives:";πCOLOR 14: PRINT lives;πCOLOR 2: PRINT TAB(11); "Points:";πCOLOR 14: PRINT Points * 100;πCOLOR 2: PRINT TAB(24); "Bonus:";πCOLOR 14: PRINT Bonus; " ";ππEND SUBπSteven Hanov HANG PERSON hanov@wchat.on.ca 04-24-96 (00:00) QB, QBasic, PDS 375 13482 HANGMAN.BAS DECLARE SUB centre (lc!, t$)πDECLARE SUB DrawGuy (parts!)πDECLARE SUB IntroScreen ()πDECLARE SUB BigPrint (t$, x!, y!, colour!, sc!)π'****************************************************************************π'* IDENTIFICATION *π'* *π'* NAME: Steven Hanov *π'* PROGRAM: a:\progC.bas * *π'* SCHOOL: Cardinal Newman C. S. S. *π'* TEACHER: Miss Gotovac *π'* COMPUTER: IBM/MS-DOS *π'* LANGUAGE: QBASIC *π'* PERIOD: LATE 20th CENTURY (Julian Calender) *π'* CLASS: DPT 3A1 Period 2 *π'* DATE: 96/04/26 *π'* *π'****************************************************************************ππ'****************************************************************************π'* PROGRAM ANALYSIS *π'* *π'* This program will simulate the game of HANG PERSON. The user may select *π'* from multiple catagories. The hanging of the person will be shown in *π'* steps. *π'****************************************************************************ππ'****************************************************************************π'* VARIABLE DICTIONARY *π'****************************************************************************πDIM p$(22)πDIM words(5, 25) AS STRING, Cats(5) AS STRING, wcount(5), ccountπDIM hints(5, 25) AS STRINGπDIM SHARED char(32 TO 126, 8, 16), m$(12)ππ'p$ contains the lines of musicπ'word$ contains the words in each catagory (cat,word#)π'Cats contains the names of the catagoriesπ'wcount contains the number of words in each catagoryπ'ccount counts the number of catagoriesπ'hints is like words but has the hints.π'char contains the character information for each pixel (0=OFF,15=ON)π'm$ contains the possible exit messagesππ'****************************************************************************π'* MAIN *π'****************************************************************************πRANDOMIZE TIMERπON PLAY(3) GOSUB musicππSCREEN 12πCLSπLOCATE 2, 1πPRINT "Please wait..."πCOLOR 15πFOR s = 32 TO 126π LOCATE 1, 1: PRINT CHR$(s) 'Scans all characters intoπ FOR y = 1 TO 16 'array CHAR().π FOR x = 1 TO 8π char(s, x, y) = POINT(x - 1, y - 1)π NEXTπ NEXTπ IF s = 95 THEN char(s, 8, 14) = 0 'Makes "_" shorterπNEXT 'so underline is separatedππGOSUB music 'Starts musicπPLAY ONππππCALL IntroScreenπDOπ READ c$π IF c$ = "ENDDATA" THEN EXIT DOπ ccount = ccount + 1π Cats(ccount) = c$π DOπ READ w$ 'Reads in all theπ IF w$ = "ENDCAT" THEN EXIT DO 'dataπ wcount(ccount) = wcount(ccount) + 1π words(ccount, wcount(ccount)) = w$π READ h$π hints(ccount, wcount(ccount)) = h$π LOOPπLOOPππReStart:ππLINE (190, 120)-(440, 340), 0, BF 'clears a portion if theπCOLOR 14 'screenπFOR s = 1 TO ccountπ LOCATE 100 \ 16 + 1 + s * 2, 200 \ 8 + 1 'Prints menu of catagoriesπ PRINT Cats(s)πNEXTπitem = 1πpitem = 1πDOπ LINE (200, 100 + (item * 2) * 16 - 8)-(430, 100 + (item * 2) * 16 + 20 - 8), 4, Bπ DOπ a$ = INKEY$ 'Filters out unacceptable keypressesπ LOOP UNTIL (a$ = CHR$(0) + CHR$(80)) OR (a$ = CHR$(0) + CHR$(72)) OR a$ = CHR$(13)π IF a$ = (CHR$(0) + CHR$(80)) AND (item < ccount) THENπ item = item + 1 'user pressed downπ ELSEIF (a$ = CHR$(0) + CHR$(72)) AND (item > 1) THENπ item = item - 1 'user pressed upπ END IFπ LINE (200, 100 + (pitem * 2) * 16 - 8)-(430, 100 + (pitem * 2) * 16 + 20 - 8), 0, Bπ pitem = item 'Clears previous box,draws newπLOOP UNTIL a$ = CHR$(13) 'Loop until ENTER pressedππLINE (100, 120)-(540, 400), 0, BFπsofar$ = "" 'What user has so far ("Th_s w_rd")πalpha$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 'What they can choose fromπcw = INT(RND * wcount(item) + 1) 'Pick random wordπword$ = words(item, cw)πh$ = hints(item, cw) 'The hintπToBeFound = LEN(word$) 'Howmany letters they have to findπFOR s = 1 TO LEN(word$)π a$ = "_" 'Puts in punctuation - don't haveπ b = ASC(MID$(LCASE$(word$), s, 1)) 'to guess /-*: etc.π IF b < 97 OR b > 122 OR b = 32 THEN a$ = CHR$(b): ToBeFound = ToBeFound - 1π sofar$ = sofar$ + a$πNEXTπ πLINE (500, 170)-(520, 390), 6, BFπLINE (400, 170)-(520, 190), 6, BFππCALL BigPrint(sofar$, 108, 128, 3, 2)πLOCATE 24, 16: COLOR 14: PRINT "Letters to choose from:"πtries = 1πlettersfound = 0πDOπ LOCATE 25, 16: COLOR 4: PRINT alpha$ 'Prints letters to choose fromπ CALL DrawGuy(tries) 'Draws guyπ ok = 0 'Flag-user picked valid letterπ DOπ DOπ b = 0 'Filters out all but alphabetπ a$ = INKEY$π IF a$ <> "" THEN b = ASC(LCASE$(a$))π LOOP UNTIL b > 96 AND b < 123π b = b - 96 'Gets number of alphabet (a=1, z=26)π IF MID$(alpha$, b, 1) <> "-" THEN ok = 1 'Checks if its already pickedπ LOOP UNTIL ok = 1 'Loops out when user picks new letterπ MID$(alpha$, b, 1) = "-" 'Makes it a "-"π found = 0π FOR s = 1 TO LEN(word$)π letter = ASC(MID$(LCASE$(word$), s, 1))π IF letter = b + 96 THEN 'If found,π found = 1 'replaces letters in wordπ lettersfound = lettersfound + 1π c$ = CHR$(letter)π IF ASC(MID$(word$, s, 1)) < 96 THEN c$ = UCASE$(c$)π MID$(sofar$, s, 1) = c$π CALL BigPrint(c$, 108 + (s - 1) * 16, 128, 3, 2)π END IFπ NEXTπ IF found = 0 THEN tries = tries + 1π IF tries = 6 THENπ LOCATE 21, 16: PRINT "HINT:"π LOCATE 22, 16: PRINT h$π END IFπLOOP UNTIL lettersfound = ToBeFound OR tries = 7ππIF tries = 7 THENπ CALL DrawGuy(7)π LOCATE 15, 16: COLOR 14: PRINT "You LOSE!"π LOCATE 16, 16: PRINT "The parts of your body"π LOCATE 17, 16: PRINT "have all decomposed."π CALL BigPrint(word$, 108, 128, 3, 2)πELSEπ LOCATE 15, 17: COLOR 14: PRINT "You WIN!"πEND IFππLOCATE 19, 16: PRINT "Play again (Y/N)?"πDOπ a$ = INKEY$π IF a$ <> "" THEN a$ = UCASE$(a$)πLOOP UNTIL a$ = "Y" OR a$ = "N"π LINE (100, 120)-(540, 400), 0, BFπ DRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50"π DRAW "ta5 r70 ta-40 r100 ta30 r90 ta70 r100 ta20 r200"π PAINT (110, 130), 4, 6π PAINT (530, 390), 6, 4πIF a$ = "Y" THEN GOTO ReStartπLINE (130, 170)-(510, 230), 0, BFπCOLOR 3πm$(1) = "Press enter to activate the electric chair."πm$(2) = "Press enter to release the chlorine gas."πm$(2) = "Press enter to release the flying baracudas."πm$(3) = "There's a demon around the next corner!"πm$(4) = "Press enter to raise the GST by 18%!"πm$(5) = "Press enter to launch the nuclear warheads."πm$(6) = "Press enter to format hard disk."πm$(7) = "Press enter to nullify all your credit cards."πLOCATE 13, 18: PRINT m$(FIX(RND * 6) + 1)πππππDO WHILE INKEY$ = "": LOOPπENDπDATA TV ShowsπDATA Seinfeld,Don't you wish you had a sein?,X-Files,Check your files for this one.πDATA "Star Trek: Voyager",Take a trek to the stars, Friends,The opposite of enemiesπDATA Masterpiece Theater,A theater of works of artπDATA Mr. Rogers Neighborhood,Everyone wants this neighborπDATA Sesame Street,Do you live on this street?πDATA Polka Dot Door,Open the door to dots!πDATA Animaniacs,These guys are animated maniacs.πDATA Barney and Friends,"I love you, you love me..."πDATA Traders,These don't deal in the fur trade...πDATA Cosby Show,Bill stars here..., Road to Avonlea, Think PEI.πDATA Home Improvement,Better your abode.πDATA The Red Green Show,Christmas ColoursπDATA Reboot,Don't press reset.πDATA Earth 2,A sequel to the planetπDATA SeaQuest DSV,Searching the oceanπDATA Cheers,A bar, ER,Think hospitals, Sliders,Banana peel!, ENDCATππDATA ComputersπDATA Hard Disk,This one too HARD for you?πDATA Monitor,Its staring you in the face!πDATA RAM,Memory,ROM,MemoryπDATA System Unit,The BRAINπDATA Floppy Disk,Media,Keyboard,You're using it now,Modem,TelephonesπDATA Mouse,Look out for the cat!πDATA Microsoft,These guys play monopoly.πDATA Binary Numbers,"01010101010"πDATA Hacker,"Not with an axe, but a mouse!"πDATA Uninterruptable Power Supply,When lightning strikes...UPSπDATA QBasic,Programming LanguageπDATA ENDCATπDATA Internet LingoπDATA Hypertext Markup Language,HTML,Universal Resource Locator,URLπDATA Home Page,You can't go home now,USENET,Do you use it?πDATA article,read 'em or write 'em.πDATA e-mail,have you send any lately?πDATA Surf the Web,Water metaphorπDATA Gopher,Small animalπDATA Wais,Oh let me count the ways!πDATA Archie,Think comics.πDATA Jughead,Eats a lot.πDATA Veronica,The rich one.πDATA Netscape,A browserπDATA Mosaic,A old browserπDATA File Transfer Protocol,FTPπDATA Point-To-Point Protocol,PPPπDATA SLIP Connection,Don't fall on the banana!πDATA World Wide Web,WWWπDATA ENDCATπDATA ENDDATAππππ'****************************************************************************π'* SUBROUTINES *π'****************************************************************************πππmusic:πIF l = 0 THENπ p$(1) = "O1T128L16MBee p16 eee e8 ee p16 e8 a#8 e"π p$(2) = "e8 eee e8 ee p16 e8 b p16 ee"π p$(3) = "p16 eee e8 ee p16 e8 >c8< eee"π p$(4) = "e p16 ee p16 e e8 >c#< p17 b p16 ee p16 e8"π p$(5) = "ee p16 ee p16 e8 a# e e8 e e8"π p$(6) = "ee p16 ee p16 e8 b p16 eee e8 e"π p$(7) = "e p16 ee p16 e8 >c<e e8 ee p16 ee"π p$(8) = "p16 e e8 >c# c <b16 >e"π p$(9) = "o2 ML b b2 b4. >c8 c2 c4 c c#8 c# c#2"π p$(10) = "c#4 d2 d8. c p16 <b p16 b MN"π p$(11) = "O1" + p$(5)π p$(12) = p$(6)π p$(13) = p$(7)π p$(14) = p$(8)π p$(15) = "O3 bgegb>c<bge<bg>e"π p$(16) = "gf#ecegage>c<gege>c<b"π p$(17) = "ag<bgegb>egbgf#ebag"π p$(18) = "be<gab>e<b>g>dc#<bgcp16<bp16"π p$(19) = "gbage<b>gb>c<babge<b>>e"π p$(20) = "gf#eage<bgb>egbageg<b"π p$(21) = "ge<gb>egb>egbgeg<bge"π p$(22) = "g<b>egbgb>dcp16<bp16"πEND IFππl = l + 1: IF l = 23 THEN l = 1πPLAY p$(l)πRETURNππSUB BigPrint (t$, x, y, colour, sc)ππFOR c = 1 TO LEN(t$)πFOR yp = 1 TO 16π FOR xx = 1 TO 8π xp = (c - 1) * 8 + xxπ IF char(ASC(MID$(t$, c, 1)), xx, yp) = 15 THENπ LINE (x + (xp * sc), y + (yp * sc))-(x + (xp * sc) + sc, y + (yp * sc) + sc), colour, BFπ END IFπ NEXTπNEXTπNEXTπππEND SUBππSUB centre (lc, t$)πLOCATE lc, 40 - LEN(t$) \ 2πPRINT t$πEND SUBππSUB DrawGuy (parts)πLINE (385, 302)-(407, 390), 0, BFπLINE (435, 302)-(412, 390), 0, BFπLINE (385, 245)-(435, 300), 0, BFπLINE (382, 245)-(370, 310), 0, BFπLINE (437, 245)-(448, 310), 0, BFπPAINT (410, 220), 0πIF parts = 7 THEN EXIT SUBπON parts GOTO Leg1, Leg2, Body, Arm1, Arm2, HeadππLeg1:πLINE (385, 302)-(407, 390), 1, BFπLeg2:πLINE (435, 302)-(412, 390), 1, BFππBody:πLINE (385, 245)-(435, 300), 4, BFππArm1:πLINE (382, 245)-(370, 310), 4, BFππArm2:πLINE (437, 245)-(448, 310), 4, BFππHead:πCIRCLE (410, 220), 20, 14πPAINT (410, 220), 14ππππEND SUBππSUB IntroScreenπPAINT (1, 1), 4πDRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50 ta5 r70"πDRAW "ta-40 r100 ta30 r90 ta70 r100 ta20 r200"πPAINT (10, 360), 6πCALL BigPrint("H", 100, 20, 14, 6)πCALL BigPrint("ang Perso", 150, 20, 14, 4.5)πCALL BigPrint("N", 480, 20, 14, 6)πLINE (100, 120)-(540, 400), 0, BFππCOLOR 5πcentre 10, "Written by Steven Hanov (hanovs@wchat.on.ca)"πCOLOR 7πcentre 12, "For computer class at"πcentre 13, "Cardinal Newman High School"πCOLOR 1πcentre 16, "The object of the game is to guess what a"πcentre 17, "word is by picking the letters. This must"πcentre 18, "done before the person's body is fully"πcentre 19, "decomposed. If you can do it, the body can"πcentre 20, " possibly be reanimated."πCOLOR 14πcentre 23, "Press any key to start."πππDO WHILE INKEY$ = "": LOOPπ LINE (100, 120)-(540, 400), 0, BFπ DRAW "c6 BM0,350 ta60 r100 ta-60 r70 ta20 r80 ta40 r100 ta -10 r50"π DRAW "ta5 r70 ta-40 r100 ta30 r90 ta70 r100 ta20 r200"π PAINT (110, 130), 4, 6π PAINT (530, 390), 6, 4πEND SUBπSteven Hanov PICK A NUMBER hanov@wchat.on.ca 04-11-96 (00:00) QB, QBasic, PDS 112 5519 PICKNUM.BAS '****************************************************************************π'* IDENTIFICATION *π'* *π'* NAME: Steven Hanov *π'* PROGRAM: a:\picknum.bas * *π'* SCHOOL: Cardinal Newman C. S. S. *π'* TEACHER: Miss Gotovac *π'* COMPUTER: IBM/MS-DOS *π'* LANGUAGE: QBASIC *π'* PLANET: Earth (Sol-III) *π'* PERIOD: LATE 20th CENTURY (Gregorian Calender) *π'* CLASS: DPT 3A1 Period 2 *π'* DATE: April 11, 1996 *π'* *π'****************************************************************************ππ'****************************************************************************π'* PROGRAM ANALYSIS *π'* *π'* This program will allow a user to entertain him or herself in a mindless *π'* and simple guessing game involving the extropolation of an unknown *π'* numeric variable between 1 and 20 using no data other than that of an *π'* approximate "high or lower" after each attempt. *π'****************************************************************************πDECLARE SUB PalDef (c!, r!, g!, b!)ππ'****************************************************************************π'* VARIABLE DICTIONARY *π'****************************************************************************ππ'A$ - a temperary variable used in various operations.π'num - the random number the computer has picked.π'y - used in for/next loops to fill background colourπ'c- used in fill-background loop to determine gradient fill colourπ'n - the number the user has picked.π'guess - the number of guesses the user takesππ'****************************************************************************π'* MAIN *π'****************************************************************************ππSCREEN 13 '320x200, 1 page, 256 coloursπRANDOMIZE TIMERπCLSπnum = INT(RND * 20) + 1 'picks random numberπFOR y = 1 TO 200π c = INT((y / 200) * 50) 'Picks gradient value, from 1 to 50π LINE (0, y)-(320, y), c 'Draws a horizontal line of colour cπ CALL PalDef(c, c, 0, 0) 'Redefines palette do make gradient fillπNEXTπCALL PalDef(0, 63, 0, 0) 'Makes default background colour REDπCALL PalDef(51, 63, 50, 0) 'Makes colour #51 yellowπDOπ LINE (20, 20)-(200, 160), 0, BF 'Draws red boxπ LOCATE 4, 4π PRINT "Guess which number"π LOCATE 5, 4: PRINT "the computer has"π LOCATE 6, 4: PRINT "picked. The arrow on "π LOCATE 7, 4: PRINT "the side will tell"π LOCATE 8, 4: PRINT "you whether to guess"π LOCATE 9, 4: PRINT "higher or lower."π DOπ LOCATE 12, 4: INPUT "> ", a$: n = VAL(a$) 'Screens out lettersπ IF n > 20 OR n < 1 THENπ LOCATE 14, 4: PRINT "The number must be"π LOCATE 15, 4: PRINT "between 1 and 20."π END IFπ LOOP UNTIL n <= 20 AND n >= 1 'Loops until number is acceptableπ LINE (230, 20)-(280, 170), 51, BF 'Yellow box clearedπ LINE (250, 40)-(260, 140), 1, BF 'draws base of arrowπ LOCATE 21, 31: PRINT n 'print guessed number in yellow boxπ IF n > num THENπ LINE (240, 140)-(270, 140), 1π LINE -(255, 150), 1 'Draws down arrowπ LINE -(240, 140), 1π PAINT (242, 141), 1π ELSEIF n < num THENπ LINE (240, 40)-(270, 40), 1π LINE -(255, 30), 1 'Draws up arrowπ LINE -(240, 40), 1π PAINT (242, 39), 1π END IFπ guess = guess + 1 'increment guessesπLOOP UNTIL n = numπLINE (230, 20)-(280, 160), 51, BF 'Clears yellow boxπFOR y = 1 TO 200π c = INT((y / 200) * 50) 'Redraws gradient fill background,π LINE (0, y)-(320, y), c 'but in yellow colour motifπ CALL PalDef(c, c, c, 0)πNEXTπCALL PalDef(0, 63, 63, 0) 'Redefines background colour to be yellowπLINE (50, 50)-(270, 150), 0, BFπs$ = "y"πIF guess > 1 THEN s$ = "ies" 'Makes "try" grammatorically correctπLOCATE 9, 8: PRINT "You correctly guessed that"πLOCATE 10, 8: PRINT "the number was"; numπLOCATE 12, 8: PRINT "It took you"; guess; "tr"; s$; "."ππWHILE INKEY$ = "": WENDπENDπ'****************************************************************************π'* SUBROUTINES *π'****************************************************************************π'PalDef(c,r,g,b) redefines colour #c to have the red, green and blue valuesπ' R,G, and B respectively ππSUB PalDef (c, r, g, b)π OUT &H3C8, cπ OUT &H3C9, rπ OUT &H3C9, gπ OUT &H3C9, bπEND SUBπThe ABC Programmer TOAD HOP (FROGGER CLONE) Adapted from Pascal code 07-15-96 (16:16) QB, QBasic, PDS 414 14071 TOADHOP.BAS '==============================================================π' TOAD HOP (Frogger Clone) Programmed by William Yu (07-15-96)π' Adapted from Pascal code (Frogger v0.90) by Jonas Maebeπ' Thanks for the tiles! :)π'π' System Recommendations:π' 486/16MHz or better or compile for best performanceπ' EGA or betterπ'π' I have never played the actual Frogger game, so I have noπ' idea if this is even close to it :)π'π' Improvements (Just some suggestions)π' ------------------------------------π' Levels! Try removing some of the cars or turtleπ' and adding them later as the level increases.π' As well as the speed of course.π' Score? Have frogger pick up misc. material laying onπ' the street or something <shrug>.π' Background? Because of my crude collision detection routine,π' you might want to limit this.π'--------------------------------------------------------------ππDEFINT A-ZπDECLARE SUB UpDate.Sprite ()πDECLARE SUB Initialize.Sprites ()πDECLARE SUB Draw.Sprite (Sprite() AS INTEGER, XCor%, YCor%)πDECLARE SUB Read.Sprite (Sprite() AS INTEGER)πDECLARE SUB Draw.Background ()πDECLARE SUB Display.Lives ()ππDIM SHARED Frog(100) AS INTEGERπDIM SHARED Car1(100) AS INTEGERπDIM SHARED Car2(100) AS INTEGERπDIM SHARED Car3(100) AS INTEGERπDIM SHARED Car4(100) AS INTEGERπDIM SHARED Turtle(100) AS INTEGERπDIM SHARED Turtle2(100) AS INTEGERπDIM SHARED Turtle3(100) AS INTEGERπDIM SHARED XCor, XCor2, XCor3, XCor4, XCor5 ' You can modify theπDIM SHARED YCor, YCor2, YCor3, YCor4, YCor5 ' value of any ofπDIM SHARED Speed1, Speed2, Speed3, Speed4, Speed5 ' these variablesπDIM SHARED FrogX, FrogY, Lives, Clock ' if you want to.πDIM SHARED Finished, Hit ' Boolean variablesππTIMER ON ' Remove this if you do not wantπON TIMER(1) GOSUB DecreaseTime ' to impose a time limitππCONST False = 0πCONST True = NOT FalseπCONST Apart = 20 ' Distance from one lane to the next (10 < Apart < 30)πCONST Seconds = 30 ' Maximum allotted time to complete levelππClock = SecondsπLives = 3 ' Number of lives REMAINING. As many as you want.π ' Maximum of four will be displayed, the rest are not.ππYCor = 160 ' Starting position of first sprite 'πYCor2 = YCor - Apart ' so on and so forth 'πYCor3 = YCor - (Apart * 2) ' . 'πYCor4 = YCor - (Apart * 3) ' . 'πYCor5 = YCor - (Apart * 5) ' You can add more if you wish 'ππSCREEN 7, , 1, 0 ' Start by hiding everythingπPRINT "Initializing data..." ' Just so the user doesn't fall asleep...πPCOPY 1, 0 ' Display the message on the visual pageππInitialize.Sprites ' Read in all the sprite dataπDraw.Background ' Spiffy background, create your own artistic sceneππFrogX = 130: FrogY = YCor + Apart ' Starting position of your spiffy frogπDraw.Sprite Frog(), FrogX, FrogY ' Let's draw the handsome dudeππI = -60 ' Okay, some weird values here.πI2 = 0 ' These are for the sprites toπI3 = -80 ' scroll across the screen smoothly.πI4 = 0 ' Mostly guess & test values hereπI5 = 0 ' but it works.πXCor = I ' The real location of each spriteπXCor2 = I2 ' to detect collision.πXCor3 = I3πXCor4 = I4πXCor5 = I5πUpDate.Sprite ' Draws all the sprites onto the screenππSpeed1 = 2 ' Speed of sprite one and so on...πSpeed2 = -3 ' (-) Negative = Sprite moves leftπSpeed3 = 6 ' (+) Positive = Sprite moves rightπSpeed4 = -2 ' Increase numbers for a fasterπSpeed5 = -2 ' and much more challenging game!ππFinished = False ' Game just started.ππDO ' Main Game Loopπ I = I + Speed1: XCor = I ' Let's move the spritesπ IF XCor >= 32 THEN I = -83π I2 = I2 + Speed2: XCor2 = I2π IF XCor2 <= -69 THEN I2 = 45π I3 = I3 + Speed3: XCor3 = I3π IF XCor3 > 60 THEN I3 = -27π I4 = I4 + Speed4: XCor4 = I4π IF XCor4 <= -64 THEN I4 = 50π I5 = I5 + Speed5: XCor5 = I5π IF XCor5 <= -32 THEN I5 = 48π UpDate.Sprite ' Update the screen to reflect new valuesπ IF Finished THEN ' Really not necessary :)π PCOPY 2, 1 ' You can end the game here.π LOCATE 2, 16: COLOR 2π PRINT "Please go back!"; CHR$(34); " "π PCOPY 1, 2π Finished = NOT Finishedπ END IFπ IF Hit = True THENπ LINE (20, 65)-(250, 85), 0, BFπ LINE (20, 65)-(250, 85), 15, Bπ IF Clock <= 0 THENπ LOCATE 10, 5: COLOR 13: PRINT "Sorry, time's up Mr. Slug!"π ELSEπ IF FrogY = YCor5 THENπ IF FrogX <= -1 THENπ LOCATE 10, 5: COLOR 11: PRINT "You went over a waterfall!"π ELSEπ LOCATE 10, 5: COLOR 11: PRINT "Try staying ON their backs"π END IFπ ELSEπ LOCATE 10, 5: COLOR 14: PRINT "Attention: Look both ways!"π END IFπ END IFπ PCOPY 1, 0π T! = TIMERπ DOπ LOOP UNTIL INKEY$ = "" AND TIMER - T! > 1.5π Clock = Seconds ' Reset Clockπ FrogY = YCor + Apart: FrogX = 130 ' Restart froggerπ Lives = Lives - 1 ' Decrease livesπ IF Lives = -1 THEN EXIT DO ' If no more, then game overπ PCOPY 2, 1π LINE (271, 0)-(319, 11), 0, BFπ Display.Livesπ PCOPY 1, 2π END IFπLOOP ' LOOP Until FinishedππSCREEN 7, , 0, 0 ' Funky ending screenπRANDOMIZE TIMERπDOπ X = INT(RND * 320) - 5π Y = INT(RND * 206) - 5π PSET (X, Y), 0π IF K& > 25000 THENπ LINE (X - 1, Y - 1)-(X + 10, Y + 10), 0π LINE (X, Y)-(X - 10, Y - 10), 0π END IFπ IF K& > 37500 THEN LINE (X - 1, Y - 1)-(X + 10, Y + 10), 0, BFπ K& = K& + 1πLOOP UNTIL INKEY$ <> "" OR K& > 40000πCLSπLOCATE 1, 1: PRINT "Thanks for playing!"πENDππDecreaseTime:π Clock = Clock - 1πRETURNππ' FroggerπDATA 00,00,00,00,02,02,00,00,00,00πDATA 00,00,00,12,10,10,12,00,00,00πDATA 00,10,00,00,10,10,00,00,10,00πDATA 00,00,10,10,10,02,10,10,00,00πDATA 00,00,00,10,02,10,10,00,00,00πDATA 00,00,00,10,10,02,10,00,00,00πDATA 00,00,00,10,02,10,10,00,00,00πDATA 00,00,10,10,10,02,10,10,00,00πDATA 00,10,00,10,10,10,10,00,10,00πDATA 00,00,00,00,10,10,00,00,00,00ππ' Normal CarπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,12,12,12,00,00,00,00πDATA 00,00,12,04,11,11,11,00,00,00πDATA 12,12,12,12,04,12,12,12,12,00πDATA 04,08,08,08,04,04,08,08,08,04πDATA 00,00,07,00,00,00,00,07,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00ππ' Flat CarπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,07,07,00,00,00,07,07,00πDATA 00,01,09,09,01,01,01,09,09,00πDATA 14,01,09,09,09,09,08,08,09,09πDATA 01,09,09,09,09,15,09,09,08,09πDATA 01,09,09,09,09,15,09,09,08,09πDATA 14,01,09,09,09,09,08,08,09,09πDATA 00,01,09,09,01,01,01,09,09,00πDATA 00,00,07,07,00,00,00,07,07,00πDATA 00,00,00,00,00,00,00,00,00,00ππ' Race CarπDATA 00,00,00,00,00,00,00,00,00,00πDATA 12,00,07,08,00,00,00,00,00,00πDATA 12,00,07,08,00,00,07,00,12,04πDATA 12,00,04,04,12,04,08,00,12,04πDATA 12,04,04,12,12,12,12,12,12,04πDATA 12,00,04,04,12,04,08,00,12,04πDATA 12,00,07,08,00,00,07,00,12,04πDATA 12,00,07,08,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00ππ' BulldozerπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,14,14,00,00,00,00,00,00,00πDATA 00,07,08,14,00,07,08,00,07,08πDATA 00,07,08,00,14,14,14,14,14,08πDATA 00,07,08,00,00,14,08,07,14,08πDATA 00,07,08,00,14,14,06,09,14,08πDATA 00,07,08,00,00,14,08,07,14,08πDATA 00,07,08,00,14,14,14,14,14,08πDATA 00,07,08,14,00,07,08,00,07,08πDATA 00,14,14,00,00,00,00,00,00,00ππ' TurtleπDATA 00,00,00,05,00,00,00,00,05,00πDATA 00,00,00,00,05,05,05,05,00,00πDATA 00,00,05,06,06,06,05,06,05,00πDATA 12,05,05,05,06,05,06,05,06,05πDATA 00,03,06,06,06,06,06,06,06,05πDATA 00,03,05,05,06,06,06,05,06,05πDATA 12,05,05,06,05,06,06,06,05,05πDATA 00,00,05,05,06,06,06,05,05,00πDATA 00,00,00,00,05,05,05,05,00,00πDATA 00,00,00,05,00,00,00,00,05,00ππ' Turtle Half Under WaterπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,06,06,06,05,06,00,00πDATA 12,00,05,05,06,05,06,05,06,00πDATA 00,00,06,06,06,06,06,06,06,00πDATA 00,00,05,05,06,06,06,05,06,00πDATA 12,00,05,06,05,06,06,06,05,00πDATA 00,00,00,05,06,06,06,05,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00ππ' Turtle Under WaterπDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,06,05,06,00,00,00πDATA 00,00,00,06,06,06,06,06,00,00πDATA 00,00,00,05,06,06,06,05,00,00πDATA 00,00,00,00,05,06,06,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00πDATA 00,00,00,00,00,00,00,00,00,00ππSUB Display.LivesππIF Lives > 4 THEN L = 4 ELSE L = LivesπFOR I = 1 TO Lπ Draw.Sprite Frog(), 263 + I * 12, 1πNEXT IππEND SUBππSUB Draw.BackgroundππLINE (0, 0)-(270, 199), 14, BπLINE (1, 198)-(269, 175), 8, BFπLOCATE 2, 2: COLOR 2πPRINT "Mother Toad: "; CHR$(34); "Please come home!"; CHR$(34)πLINE (1, YCor5 - 6)-(269, YCor5 + 15), 1, BFπLINE (1, YCor5 + 15)-(269, YCor4 - 7), 8, BFπLINE (1, YCor5 - 6)-(269, YCor5 - 26), 2, BFπDOπ RANDOMIZE TIMERπ Y = ((YCor5 - 6) - (YCor5 - 26) + 1) * RND + (YCor5 - 26)π X = RND * 269π PSET (X, Y), 10π N = N + 1πLOOP UNTIL N = 100πDisplay.LivesπPCOPY 1, 2 ' Save BackgroundππEND SUBππSUB Draw.Sprite (Sprite() AS INTEGER, XCor, YCor)ππI = 0πFOR Y = 1 TO 10π FOR X = 1 TO 10π I = I + 1π IF Sprite(I) > 0 THEN PSET (XCor + X - 1, YCor + Y - 1), Sprite(I)π NEXT XπNEXT YππEND SUBππSUB Initialize.SpritesππRead.Sprite Frog()πRead.Sprite Car1()πRead.Sprite Car2()πRead.Sprite Car3()πRead.Sprite Car4()πRead.Sprite Turtle()πRead.Sprite Turtle2()πRead.Sprite Turtle3()πCLSππEND SUBππSUB Read.Sprite (Sprite() AS INTEGER)ππI = 0πFOR Y = 1 TO 10π FOR X = 1 TO 10π I = I + 1π READ Sprite(I)π IF Sprite(I) > 0 THEN PSET (X, Y), Sprite(I)π NEXT XπNEXT YππEND SUBππSUB UpDate.SpriteππLINE (0, 0)-(319, 199), 0, BF ' Clear the screen for next updateπPCOPY 2, 1 ' Restore the saved backgroundππIF XCor5 < 5 OR XCor5 > 25 THEN Under = 1πIF XCor5 < -15 OR XCor5 > 35 THEN Under = 2πIF XCor5 < -25 THEN Under = 3πIF XCor5 > 5 AND XCor5 < 30 THEN Under = 0πIF FrogY = YCor5 THEN FrogX = FrogX + Speed5 ' Frog on Turtle's backπHit = False: NoMore = Falseπ πFOR Y = 1 TO 4π IF NOT NoMore THEN A$ = INKEY$ ' Depending upon the position of Froggerπ FOR X = 1 TO 3π IF A$ <> "" AND NOT Hit THENπ IF LEN(A$) > 1 THEN Char = -ASC(RIGHT$(A$, 1)) ELSE Char = ASC(A$)π SELECT CASE Charπ CASE 27π ENDπ CASE -72 ' Upπ IF FrogY > YCor5 - Apart THENπ FrogY = FrogY - Apartπ IF FrogY = YCor5 - Apart THEN Finished = Trueπ END IFπ CASE -75 ' Leftπ IF FrogX > 9 THENπ FrogX = FrogX - 10π END IFπ CASE -77 ' Rightπ IF FrogX < 260 THENπ FrogX = FrogX + 10π END IFπ CASE -80 ' Downπ IF FrogY < 200 - Apart THENπ FrogY = FrogY + Apartπ END IFπ END SELECTπ A$ = ""π END IFπ ' Cheap way of detecting a collisionπ IF (FrogY < YCor + Apart) AND (FrogY > YCor - (Apart * 4)) THENπ A = POINT(FrogX + 1, FrogY + 5)π B = POINT(FrogX + 8, FrogY + 5)π C = POINT(FrogX + 5, FrogY + 5)π IF (A OR B OR C) > 0 THEN Hit = Trueπ END IFπ IF FrogY = YCor5 THEN NoMore = True ' Frogger is on the riverπ Draw.Sprite Car1(), XCor, YCorπ Draw.Sprite Car2(), XCor2, YCor2π Draw.Sprite Car3(), XCor3, YCor3π Draw.Sprite Car4(), XCor4, YCor4π IF Under = 1 THEN ' Half way below waterπ Draw.Sprite Turtle2(), XCor5, YCor5π ELSEIF Under = 2 THEN ' Almost under waterπ Draw.Sprite Turtle3(), XCor5, YCor5π ELSEIF Under = 3 THEN ' Submerged under waterπ LINE (1, YCor5 - 4)-(269, YCor5 + 12), 1, BFπ ELSEIF Under = 0 THEN ' Completely above waterπ Draw.Sprite Turtle(), XCor5, YCor5π END IFπ XCor = XCor + 30 ' Distance between common spritesπ XCor2 = XCor2 + 30 ' To chain three sprites at a timeπ XCor3 = XCor3 + 90π XCor4 = XCor4 + 30π XCor5 = XCor5 + 15π NEXT Xπ XCor = XCor + 25 ' Extra distance between the spritesπ XCor2 = XCor2 + 25 ' This allows room for your frog to passπ XCor4 = XCor4 + 25π XCor5 = XCor5 + 35πNEXT YπIF FrogY = YCor5 THEN ' Frogger is on the river.π C = POINT(FrogX + 5, FrogY + 5) ' Check if frog is on a turtleπ IF C = 1 THEN Hit = True ' or not.π IF FrogX <= -1 THEN Hit = True ' Or if the frog sits too longπEND IFπDraw.Sprite Frog(), FrogX, FrogY ' Update frog positionπLINE (0, 0)-(270, 199), 14, B ' Redraw the borderπLINE (271, 12)-(319, 199), 0, BF ' Hide tailing spritesπLOCATE 4, 36: COLOR 15: PRINT ClockπIF Clock = 0 THEN Hit = TrueπPCOPY 1, 0 ' Display to finished screenππEND SUBπKurt Kuzba AVOID BLUE MEANIES FidoNet QUIK_BAS Echo 04-28-96 (00:00) QB, QBasic, PDS 142 5773 ARG.BAS '_|_|_| A game based on an original game posted on FIDO.π'_|_|_| From: Andrew Jones ... Echo: FidoQBasicπ'_|_|_| Date: 04-14-96 14:33 ... Subj: arg.basπ'_|_|_| No warrantees or guarantees are given or implied.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (4/28/96)πDECLARE FUNCTION bounc% ()πTYPE dotdata: ox AS INTEGER: xd AS INTEGER: x AS INTEGERπ oy AS INTEGER: yd AS INTEGER: y AS INTEGER: END TYPEπDIM dot(21) AS dotdata, me(15) AS INTEGER, they(15) AS INTEGERπRANDOMIZE (TIMER * 1000): SCREEN 13πCIRCLE (160, 100), 2, 33: PAINT (160, 100), 33πGET (158, 98)-(162, 102), theyπCIRCLE (160, 100), 2, 65: PAINT (160, 100), 65πGET (158, 98)-(162, 102), meπdot(0).x = 158: dot(0).y = 98: dot(0).xd = 0: dot(0).yd = 0πlevel% = 1000πDOπ CLS : b$ = STRING$(6, CHR$(177)): S$ = SPACE$(34)π LOCATE 6, 1: P$ = STRING$(43, CHR$(177)) + S$ + b$π P$ = P$ + " Avoid all the Blue Meanies while " + b$ + S$ + b$π P$ = P$ + " the red line crosses the screen! " + b$ + S$ + b$π P$ = P$ + " Use the Cursor keys to move. " + b$ + S$ + b$π P$ = P$ + " The ESCAPE key quits the game. " + b$ + S$ + b$π P$ = P$ + " The P key pauses the game. " + b$ + S$ + b$π P$ = P$ + " Possible scores are 0 - 100. " + b$ + S$ + b$π P$ = P$ + " Press any key to begin game. " + b$ + S$ + b$π P$ = P$ + STRING$(37, CHR$(177))π WHILE INKEY$ <> "": WEND: c% = 64π WHILE INKEY$ = ""π LOCATE 4, 1: COLOR c%: PRINT P$π c% = (c% + 1) MOD 103: IF c% = 0 THEN c% = 64π WENDπ CLSπ FOR t% = 1 TO 20π DO: P% = RND * 300 + 14: LOOP WHILE (P% > 100) AND (P% < 214)π dot(t%).x = P%: dot(t%).xd = bounc%π DO: P% = RND * 180 + 14: LOOP WHILE (P% > 70) AND (P% < 144)π dot(t%).yd = bounc%: dot(t%).y = P%π PUT (dot(t%).x, dot(t%).y), they, XORπ NEXTπ dot(0).x = 155: dot(0).y = 95: PUT (dot(0).x, dot(0).y), me, XORπ Quit% = 0: Resets& = 1: Score& = 0: Total& = 0π DO: K$ = "": K$ = UCASE$(INKEY$)π IF K$ = CHR$(27) THEN Total& = Total& + Score&: EXIT DOπ IF K$ = "P" THENπ WHILE INKEY$ <> "": WEND: WHILE INKEY$ = "": WENDπ END IFπ WHILE (INP(&H3DA) AND 8) = 0: WENDπ WHILE (INP(&H3DA) AND 8) <> 0: WENDπ FOR egg% = 1 TO 10 + (Score& \ 300)π IF ABS(dot(egg%).x - dot(0).x) < 3 THENπ IF ABS(dot(egg%).y - dot(0).y) < 3 THENπ Resets& = Resets& + 1π Total& = Total& + Score&π Score& = 0: SOUND 80, 3π FOR t% = 196 TO 199π LINE (0, t%)-(319, t%), 0π NEXTπ SOUND 65, 5π END IFπ END IFπ dot(egg%).ox = dot(egg%).x: dot(egg%).oy = dot(egg%).yπ dot(egg%).x = dot(egg%).x + dot(egg%).xdπ dot(egg%).y = dot(egg%).y + dot(egg%).ydπ IF dot(egg%).x < 0 THENπ dot(egg%).x = 0: dot(egg%).xd = ABS(bounc%)π SOUND 999, .03π END IFπ IF dot(egg%).x > 314 THENπ dot(egg%).x = 314: dot(egg%).xd = -(ABS(bounc%))π SOUND 999, .03π END IFπ IF dot(egg%).y < 0 THENπ dot(egg%).y = 0: dot(egg%).yd = ABS(bounc%)π SOUND 999, .03π END IFπ IF dot(egg%).y > 190 THENπ dot(egg%).y = 190: dot(egg%).yd = -(ABS(bounc%))π SOUND 999, .03π END IFπ PUT (dot(egg%).ox, dot(egg%).oy), they, XORπ PUT (dot(egg%).x, dot(egg%).y), they, XORπ NEXTπ x% = 0: y% = 0π SELECT CASE INP(&H60)π CASE 72: IF dot(0).y > 15 THEN y% = -2π CASE 75: IF dot(0).x > 15 THEN x% = -2π CASE 77: IF dot(0).x < 300 THEN x% = 2π CASE 80: IF dot(0).y < 175 THEN y% = 2π END SELECTπ K$ = "": K$ = UCASE$(INKEY$)π IF K$ = CHR$(27) THEN Total& = Total& + Score&: EXIT DOπ IF K$ = "P" THENπ WHILE INKEY$ <> "": WEND: WHILE INKEY$ = "": WENDπ END IFπ WHILE (INP(&H3DA) AND 8) = 0: WENDπ WHILE (INP(&H3DA) AND 8) <> 0: WENDπ IF (x% <> 0) OR (y% <> 0) THENπ PUT (dot(0).x, dot(0).y), me, XORπ dot(0).x = dot(0).x + x%: dot(0).y = dot(0).y + y%π PUT (dot(0).x, dot(0).y), me, XORπ END IFπ IF Score& MOD 30 = 0 THENπ LINE (Score& \ 10, 196)-(Score& \ 10, 199), 4π END IFπ Score& = Score& + 1π IF Score& > 3199 THEN Total& = Total& + Score&: EXIT DOπ LOOPπ IF Score& > 3199 THENπ SOUND 500, 2: COLOR RND * 20 + 50: SOUND 700, 5: LOCATE 11, 16π SOUND 600, 2: PRINT "YOU WON !!": SOUND 800, 7π WHILE INKEY$ <> "": WENDπ DOπ COLOR RND * 20 + 50: LOCATE 11, 16: PRINT "YOU WON !!"π LOOP WHILE INKEY$ = ""π level% = level% * .8π ELSE level% = 1000π END IFπ bl$ = CHR$(221): br$ = CHR$(222): COLOR RND * 50 + 40π LOCATE 7, 15: PRINT CHR$(220); STRING$(10, CHR$(223)); CHR$(220)π LOCATE 8, 15: PRINT bl$; "GAME OVER "; br$π P$ = LEFT$(STR$(FIX((Total& \ Resets&) \ 32)) + " ", 4)π LOCATE 9, 15: PRINT bl$; "SCORE:"; P$; br$π LOCATE 10, 15: PRINT bl$; "PLAY AGAIN"; br$π LOCATE 11, 15: PRINT bl$; " (Y/N)? "; br$π LOCATE 12, 15: PRINT CHR$(223); STRING$(10, CHR$(220)); CHR$(223)π Que$ = ". YN" + CHR$(13)π DOπ Query$ = UCASE$(INKEY$): DEF SEG = &HA000π L& = (RND * 100 + 110) + (320 * FIX(RND * 48 + 48))π IF PEEK(L&) <> 0 THEN POKE L&, RND * 20 + 75π LOOP WHILE INSTR(Que$, Query$) < 2π IF INSTR(Que$, Query$) > 3 THEN Quit% = -1πLOOP WHILE NOT Quit%πSCREEN 0: WIDTH 80, 25ππFUNCTION bounc%π SHARED Score&, level%π b% = (RND MOD (2 + (Score& \ level%))) + 1π IF (INP(64) AND 1) = 0 THEN b% = -b%π bounc% = b%πEND FUNCTIONπSteven Hanov PACMAN LIVES! hanovs@wchat.on.ca 07-18-96 (23:20) QB, QBasic, PDS 753 21383 PACMAN.BAS '**************************************************************************π'** PACMAN LIVES! **π'**** By Steven Hanov (hanovs@wchat.on.ca) **π'**************************************************************************π'** July 1996 **π'** Well, here's MY attempt at Pacman for QBASIC. I derived this game **π'** from the Commodore 64 version, which was probably based on the Atari **π'** version. Quite a long history! I think it even had a cartoon show... **π'** On a 386, like mine :-(, a speed factor of zero should be used. The **π'** graphics routines are slower than I'd have liked, but that's life. **π'** If anyone manages to speed it up greatly, I'd appreciate a copy. **π'** Just e-mail it to me. **π'**************************************************************************ππDECLARE SUB pacprint (y!, text$)πDECLARE SUB KillPac ()πDECLARE SUB DisplayLives (lives!)πDECLARE SUB UpdateScore ()πDECLARE SUB RedGhost ()πDECLARE SUB GreenGhost ()πDECLARE SUB BlueGhost ()πDECLARE SUB CreateGhost (colour!, frame!)πDECLARE SUB DrawPac (xx!, yy!, dr!)πDIM SHARED pf(-1 TO 81, 25) AS STRING, PacGraph(628)πDIM SHARED BGhost1(628), rGhost1(628), gGhost1(628), ZGhost1(628)πDIM SHARED BGhost2(628), rGhost2(628), GGhost2(628), ZGhost2(628)πDIM SHARED death, PowerUp, PTimer, xx, yy, Score, DontCallGhostsπDIM SHARED GameSpeedπ'*********************************************************************π'** VARIABLE Dictionary **********************************************π'pf(x,y) contains the playing field, * for walls, . for dashes, o for powerupπ'PacGraph, and the Ghosts store the "sprites" of pacman circle and ghostsπ'death - Set by ghost sub to notify main that Pacman has been killedπ'PowerUp - 1 if currently Powered Up, zero otherwiseπ'PTimer - The timer at the time Pacman got powerup.π'xx,yy - usually The current 320x200 screen positionπ'x,y - usually the current 40x25 screen positionπ'DontCallGhosts - Flag used to make DrawPac not call Ghostsπ'GameSpeed - Slow down factorππrt$ = CHR$(0) + "M" 'define right, left, up, down keysπlt$ = CHR$(0) + "K"πup$ = CHR$(0) + "H"πdn$ = CHR$(0) + "P"πSCREEN 12πCIRCLE (150, 200), 150, 14πPAINT (150, 200), 14πLINE (150, 200)-(300, 160), 15πLINE -(300, 240), 15πLINE -(150, 200)πPAINT (160, 200), 0, 15 'The next several lines drawπLINE (150, 200)-(300, 160), 0 'the title screen...πLINE -(300, 240), 0πLINE -(150, 200), 0πCIRCLE (175, 125), 30, 0πPAINT (175, 125), 15, 0πCIRCLE (180, 130), 20, 0πPAINT (180, 130), 0, 0πCIRCLE (500, 150), 100, 4πPAINT (500, 150), 4πLINE (400, 150)-(400, 400), 4πLINE (600, 150)-(600, 400), 4πDRAW "BM600,400 H20 G20 H20 G20 H20 G20 H20 G20 H20 G20"πPAINT (500, 300), 4πCIRCLE (450, 150), 25, 0πCIRCLE (550, 150), 25, 0πPAINT (450, 150), 15, 0πPAINT (550, 150), 15, 0πCIRCLE (440, 150), 12, 0πCIRCLE (540, 150), 12, 0πPAINT (440, 150), 0πPAINT (540, 150), 0πCIRCLE (500, 225), 30, 0, , , .5πPAINT (500, 225), 0, 0πCOLOR 9πx = 25πy = 0πLINE (x, y)-(x + 30, y + 100), 9, BFπCIRCLE (x + 35, y + 31), 30, 9πPAINT (x + 35, y + 31), 9, 9πCIRCLE (x + 35, y + 31), 2, 0πPAINT (x + 35, y + 31), 0, 0πx = x + 60πLINE (x + 40, y)-(x, y + 100)πLINE -(x + 80, y + 100)πLINE -(x + 40, y)πPAINT (x + 40, y + 50), 9, 9πCIRCLE (x + 40, y + 50), 2, 0πPAINT (x + 40, y + 50), 0, 0πx = x + 90πCIRCLE (x + 40, y + 50), 50πPAINT (x + 40, y + 50), 9, 9πLINE (x + 40, y + 50)-(x + 90, y + 20), 0πLINE -(x + 90, y + 80), 0πLINE -(x + 40, y + 50), 0πPAINT (x + 60, y + 50), 0, 0πx = x + 90πLINE (x + 10, y + 40)-(x + 40, y + 60), 9, BFπx = x + 50ππLINE (x, y)-(x, y + 100), 9πLINE -(x + 90, y + 100), 9πLINE -(x + 90, y), 9πLINE -(x + 45, y + 50), 9πLINE -(x, y), 9πPAINT (x + 45, y + 75), 9, 9ππx = x + 100πLINE (x + 40, y)-(x, y + 100)πLINE -(x + 80, y + 100)πLINE -(x + 40, y)πPAINT (x + 40, y + 50), 9, 9πCIRCLE (x + 40, y + 50), 2, 0πPAINT (x + 40, y + 50), 0, 0πx = x + 90πLINE (x, y)-(x, y + 100), 9πLINE -(x + 90, y + 100), 9πLINE -(x + 90, y), 9πLINE -(x + 60, y), 9πLINE -(x + 60, y + 50), 9πLINE -(x, y), 9πPAINT (x + 30, y + 30), 9, 9ππCOLOR 15πLOCATE 8, 36πPRINT "Lives!"πLOCATE 28, 20πCOLOR 9πPRINT "Coded by Steven Hanov (hanovs@wchat.on.ca)"ππWHILE INKEY$ = "": WENDπSCREEN 7 'OK, now the real program begins!πRANDOMIZE TIMERπCLSπCIRCLE (12, 12), 5, 14πPAINT (12, 12), 14πGET (7, 7)-(17, 17), PacGraphπCreateGhost 9, 1 'Create and store "sprites"πGET (1, 0)-(11, 9), BGhost1πCreateGhost 9, 2πGET (1, 0)-(11, 9), BGhost2πCreateGhost 4, 1πGET (1, 0)-(11, 9), rGhost1πCreateGhost 4, 2πGET (1, 0)-(11, 9), rGhost2πCreateGhost 2, 1πGET (1, 0)-(11, 9), gGhost1πCreateGhost 2, 2πGET (1, 0)-(11, 9), GGhost2πCreateGhost 1, 1πGET (1, 0)-(11, 9), ZGhost1πCreateGhost 1, 2πGET (1, 0)-(11, 9), ZGhost2πCLSπpacprint 5, "Enter a delay factor, to"πpacprint 6, "slow down the game for"πpacprint 7, "fast computers. (0-15)"πLOCATE 9, 18: INPUT ">", a$πGameSpeed = VAL(a$) * 100πStart:πCLSπRESTOREπlives = 3πy = 0πxx = 0πyy = 0πDOπ READ a$ 'Read in, store, and displayπ IF a$ = "STOP" THEN EXIT DO 'the playing field. (Stored in pf())π yy = yy + 1π FOR xx = 1 TO LEN(a$)π y = yy * 8 - 8π x = xx * 8 - 8π B$ = MID$(a$, xx, 1)π IF B$ = "." THENπ LOCATE yy, xx + 1π LINE (x + 3, y + 4)-(x + 5, y + 5), 14, Bπ pf(xx, yy) = B$π dots = dots + 1π ELSEIF B$ = "o" THENπ LOCATE yy, xx + 1π CIRCLE (x + 4, y + 4), 3, 14π PAINT (x + 4, y + 4), 14, 14π pf(xx, yy) = B$π ELSEIF B$ = " " THENπ PRINT " ";π pf(xx, yy) = " "π ELSEπ COLOR 1 'For simplicity, all wall blocks areπ PRINT B$; 'stored in pf() array as "*"'sπ pf(xx, yy) = "*"π END IFπ NEXTπ PRINTπLOOPπDOπ x = 20π y = 18π xx = x * 8 - 8π yy = y * 8 - 8π dr = 4π DisplayLives livesπ PCOPY 0, 1π DrawPac xx + 1, yy, 4π DrawPac xx, yy, 4π a$ = ""π DO 'This big DO-LOOP is the heart of theπ IF LEN(c$) = 0 THEN 'program, detecting keys and movingπ B$ = INKEY$ 'pacman.π ELSEπ B$ = c$π c$ = ""π END IFπ DrawPac xx, yy, drπ IF LEN(B$) > 0 THENπ IF B$ = CHR$(27) THEN CLS : GOTO Quitπ free = 0π π IF B$ = up$ AND pf(x, y - 1) <> "*" THEN free = free + 1π IF B$ = rt$ AND pf(x + 1, y) <> "*" THEN free = free + 1π IF B$ = dn$ AND pf(x, y + 1) <> "*" THEN free = free + 1π IF B$ = lt$ AND pf(x - 1, y) <> "*" THEN free = free + 1π IF free > 0 THENπ a$ = B$π c$ = ""π END IFπ END IFπ IF a$ = rt$ AND pf(x + 1, y) <> "*" THENπ dr = 2π FOR s = 1 TO 8π xx = xx + 1π DrawPac xx, yy, drπ NEXTπ x = x + 1π IF x = 39 THEN x = 1: xx = 1: DrawPac xx, yy, drπ ELSEIF a$ = lt$ AND pf(x - 1, y) <> "*" THENπ dr = 4π FOR s = 1 TO 8π xx = xx - 1π DrawPac xx, yy, drπ IF xx = 1 THEN x = 40: xx = 39 * 8 - 8π NEXTπ x = x - 1π ELSEIF a$ = up$ AND pf(x, y - 1) <> "*" THENπ dr = 1π FOR s = 1 TO 8π yy = yy - 1π DrawPac xx, yy, drπ NEXTπ y = y - 1π ELSEIF a$ = dn$ AND pf(x, y + 1) <> "*" THENπ dr = 3π FOR s = 1 TO 8π yy = yy + 1π DrawPac xx, yy, drπ NEXTπ y = y + 1π END IFπ IF pf(x, y) = "." THENπ Score = Score + 10π pf(x, y) = " "π dots = dots - 1π SOUND 800, .25π SOUND 900, .25π UpdateScoreπ IF dots = 0 THEN EXIT DOπ ELSEIF pf(x, y) = "o" THENπ PowerUp = 1π pf(x, y) = " "π Score = Score + 100π UpdateScoreπ FOR s = 37 TO 4000 STEP 20π SOUND s, .05π SOUND s + 100, .05π SOUND s + 200, .05π SOUND s + 300, .05π NEXTπ PTimer = TIMERπ END IFπ IF xx MOD 8 = 1 THEN xx = xx - 1π IF death = 1 THEN KillPac: EXIT DOπ LOOPπ IF dots = 0 THEN EXIT DOπ lives = lives - 1π DisplayLives livesπ death = 0πLOOP UNTIL lives = -1πCLSπCOLOR 4πIF lives = -1 THENπ pacprint 10, "You LOSE!"πELSEπ pacprint 10, "You WIN!"πEND IFπSLEEP 1ππQuit:πCOLOR 15πpacprint 15, "Final Score:" + STR$(Score)πCOLOR 9πpacprint 20, "ENTER to play again, or ESC to exit"πDOπ a$ = INKEY$πLOOP UNTIL a$ = CHR$(27) OR a$ = CHR$(13)πIF a$ = CHR$(27) THEN SCREEN 0: COLOR 7: ENDπIF a$ = CHR$(13) THEN GOTO Startπππππππ' 1234567890123456789012345678901234567890πDATA "╔══════════════════╦══════════════════╗"πDATA "║..................║..................║"πDATA "║.┌────┐.┌───────┐.║.┌───────┐.┌────┐.║"πDATA "║.│ │.│ │.║.│ │.│ │.║"πDATA "║o└────┘.└───────┘.║.└───────┘.└────┘o║"πDATA "║.....................................║"πDATA "║.══════.┌─┐.══════╦══════.┌─┐.══════.║"πDATA "║........│ │.......║.......│ │........║"πDATA "╚══════╗.│ ╞══════ ║ ══════╡ │.╔══════╝"πDATA " ║.│ │ │ │.║ "πDATA "═══════╝.└─┘ ┌───── ─────┐ └─┘.╚═══════"πDATA " .......... │ │ .......... "πDATA "═══════╗.┌─┐ └───────────┘ ┌─┐.╔═══════"πDATA " ║.│ │ │ │.║ "πDATA "╔══════╝.└─┘ ══════╦══════ └─┘.╚══════╗"πDATA "║..................║..................║"πDATA "║.═════╗.═════════.║.═════════.╔═════.║"πDATA "║o.....║.......................║.....o║"πDATA "╠═════.║.┌─┐.══════╦══════.┌─┐.║.═════╣"πDATA "║........│ │.......║.......│ │........║"πDATA "║.═══════╧═╧══════.║.══════╧═╧═══════.║"πDATA "║.....................................║"πDATA "╚═════════════════════════════════════╝"πππDATA STOPππ'Takes care of blue ghost.π'And I mean it takes care of EVERYTHING:π'Drawing, artificial intelligence, killing Pacman, Killing itself...etc.π'πSUB BlueGhostππ'VARIABLES:π'px,py - current pixel positionπ'PrevX,PrevY - previous pixel position (for erasing)π'flag - First time called?π'xdir, ydir - Which direction am I going in? (incremental values)ππSTATIC frame, PrevX, PrevY, flag, px, py, xdir, ydirπIF flag = 0 THENπ flag = 1 'If first time called,π PrevX = 17 * 8 - 8 'Set ghost to default positionπ PrevY = 12 * 8 - 8π px = PrevXπ py = PrevYπ xdir = 1 'Start off going rightπ ydir = 0πEND IFπIF PowerUp = 1 THENπ speed = .5 'Powerup means half speed of ghostsπELSEπ speed = 1πEND IFππLINE (PrevX, PrevY)-(PrevX + 10, PrevY + 9), 0, BF 'ERase previous drawππIF px MOD 8 = 0 AND py MOD 8 = 0 THEN 'If you're centered on 8x8 box,π x = (px \ 8) + 1 'Calculate real 40x25 screen positionπ y = (py \ 8) + 1π IF pf(x - xdir, y - ydir) = "." THEN 'Redraw the pellet you passedπ xp = CINT(px) - 8 * xdir 'overπ yp = CINT(py) - 8 * ydirπ LINE (xp + 3, yp + 4)-(xp + 5, yp + 5), 14, Bπ ELSEIF pf(x - xdir, y - ydir) = "o" THEN 'redraw the powerup you passedπ xp = CINT(px) - 8 * xdir 'overπ yp = CINT(py) - 8 * ydirπ CIRCLE (xp + 4, yp + 4), 3, 14π PAINT (xp + 4, yp + 4), 14, 14π END IFπ IF pf(x, y + 1) <> "*" THEN free = free + 1 'Count the number of choicesπ IF pf(x + 1, y) <> "*" THEN free = free + 1 'of directions without wallsπ IF pf(x, y - 1) <> "*" THEN free = free + 1π IF pf(x - 1, y) <> "*" THEN free = free + 1π IF free > 2 OR pf(x + xdir, y + ydir) = "*" THEN 'IF you HAVE a choice,π DOπ IF RND > .5 THENπ xdir = 1π ydir = 0 'Keep picking a random direction untilπ ELSE 'you find one without a wall.π ydir = 1π xdir = 0π END IFπ IF RND > .5 THEN xdir = -xdir: ydir = -ydirπ IF pf(x + xdir, y + ydir) <> "*" THEN EXIT DOπ LOOPπ END IFπEND IFπpx = px + xdir * speed 'Move the px,py co-ordinateπpy = py + ydir * speedπIF px > 309 THEN px = 1 'Scroll from one side of screen to otherπIF CINT(px) = 0 THEN px = 304πframe = frame + 1: IF frame = 2 THEN frame = 0 'Ghosts have two frames forπIF frame = 0 THEN 'animationπ IF PowerUp = 1 THENπ PUT (px, py), ZGhost1 'You have powerup, show scared ghostπ ELSEπ PUT (px, py), BGhost1 'Show regular ghostπ END IFπELSEπ IF PowerUp = 1 THEN 'OR frame 2 of same.π PUT (px, py), ZGhost2π ELSEπ PUT (px, py), BGhost2π END IFπEND IFπPrevX = CINT(px)πPrevY = CINT(py)ππ gx = (px \ 8) + 1π gy = (py \ 8) + 1π IF gx = xx \ 8 + 1 AND gy = yy \ 8 + 1 THEN 'If you hit Pacman,π IF PowerUp = 1 THENπ Score = Score + 200 'And he has powerup, kill ghostπ UpdateScoreπ FOR s = 37 TO 5000 STEP 500π SOUND s, 1π NEXTπ flag = 0π ELSEπ death = 1 'OR else kill Pacman.π END IFπ END IFπππEND SUBππSUB CreateGhost (colour, frame)πCLSπCIRCLE (6, 3), 5, colour, 0, 6.28, .5πLINE (1, 3)-(11, 8), colour, BFπPAINT (6, 2), colour, colourπCIRCLE (3, 3), 1, 15πCIRCLE (9, 3), 1, 15πPSET (3, 3), 15πPSET (9, 3), 15πSELECT CASE frameπ CASE 1π DRAW "BM1,9 C" + STR$(colour) + " e1f1e1f1e1F1e1f1e1f1"π PSET (4, 3), 0π PSET (10, 3), 0π CASE 2π DRAW "BM1,8 C" + STR$(colour) + " f1e1f1e1f1e1f1e1f1e1"π PSET (2, 3), 0π PSET (8, 3), 0πEND SELECTπIF colour = 1 THENπ DRAW "BM2,7 C0 e1r1f1r1e1r1f1r1"πEND IFπEND SUBππSUB DisplayLives (lives)ππx = 308πy = 187πLINE (x + 5, y - 5)-(x - 100, y + 5), 0, BFπFOR s = 1 TO livesπ GOSUB TinyPacπ x = x - 16πNEXTπEXIT SUBππTinyPac:πCIRCLE (x - 1, y), 4, 14πPAINT (x - 1, y), 14, 14πLINE (x, y)-(x - 5, y - 2), 0πLINE (x, y)-(x - 5, y + 2), 0πLINE -(x - 5, y - 2), 0πPAINT (x - 3, y), 0, 0πRETURNππEND SUBππSUB DrawPac (xx, yy, dr)πSTATIC a, PrevX, PrevY, flag, adirπFOR s = 1 TO GameSpeed: NEXTπIF flag = 0 THEN 'If first time called, set PrevX,Y to same as xx,yyπ adir = 1π flag = 1π PrevX = xxπ PrevY = yyπEND IFπIF xx = 0 THEN xx = 1 'Solves mysterious problem.πIF PrevX <> xx OR PrevY <> yy THEN 'Don't redraw if standing still.π a = a + adir '"a" value moves mouthπ IF a = 5 OR a = 0 THEN adir = -adirπ LINE (PrevX - 1, PrevY)-(PrevX + 10, PrevY + 8), 0, BFπ PUT (xx - 1, yy - 1), PacGraphπ SELECT CASE dr 'dr is direction:1=up, clockwise.π CASE 1π LINE (xx + 4, yy + 5)-(xx + 4 - a, yy), 0π LINE (xx + 4, yy + 5)-(xx + 4 + a, yy), 0π LINE -(xx + 4 - a, yy), 0π PAINT (xx + 4, yy + 1), 0, 0π CASE 2π LINE (xx + 3, yy + 4)-(xx + 9, yy + 4 - a), 0π LINE (xx + 3, yy + 4)-(xx + 9, yy + 4 + a), 0π LINE -(xx + 9, yy + 4 - a), 0π PAINT (xx + 7, yy + 4), 0, 0π CASE 3π LINE (xx + 4, yy + 3)-(xx + 4 - a, yy + 8), 0π LINE (xx + 4, yy + 3)-(xx + 4 + a, yy + 8), 0π LINE -(xx + 4 - a, yy + 8), 0π PAINT (xx + 4, yy + 7), 0, 0π CASE 4π LINE (xx + 5, yy + 4)-(xx - 1, yy + 4 - a), 0π LINE (xx + 5, yy + 4)-(xx - 1, yy + 4 + a), 0π LINE -(xx - 1, yy + 4 - a), 0π PAINT (xx, yy + 4), 0, 0π END SELECTπEND IFπPrevX = xxπPrevY = yyππIF TIMER - PTimer > 10 THEN PowerUp = 0 'Powerup lasts 10 secondsπIF DontCallGhosts = 0 THENπ RedGhostπ GreenGhost 'Move the three ghostsπ BlueGhostπEND IFπEND SUBππ'For comments, see BlueGhost subπSUB GreenGhostπSTATIC frame, PrevX, PrevY, flag, px, py, xdir, ydirπIF flag = 0 THENπ flag = 1π PrevX = 17 * 8 - 8π PrevY = 12 * 8 - 8π px = PrevXπ py = PrevYπ xdir = 1π ydir = 0πEND IFπIF PowerUp = 1 THENπ speed = .5πELSEπ speed = 1πEND IFππLINE (PrevX, PrevY)-(PrevX + 10, PrevY + 9), 0, BFππIF px MOD 8 = 0 AND py MOD 8 = 0 THENπ x = (px \ 8) + 1π y = (py \ 8) + 1π IF pf(x - xdir, y - ydir) = "." THENπ xp = CINT(px) - 8 * xdirπ yp = CINT(py) - 8 * ydirπ LINE (xp + 3, yp + 4)-(xp + 5, yp + 5), 14, Bπ ELSEIF pf(x - xdir, y - ydir) = "o" THENπ xp = CINT(px) - 8 * xdirπ yp = CINT(py) - 8 * ydirπ CIRCLE (xp + 4, yp + 4), 3, 14π PAINT (xp + 4, yp + 4), 14, 14π END IFπ IF pf(x, y + 1) <> "*" THEN free = free + 1π IF pf(x + 1, y) <> "*" THEN free = free + 1π IF pf(x, y - 1) <> "*" THEN free = free + 1π IF pf(x - 1, y) <> "*" THEN free = free + 1π IF free > 2 OR pf(x + xdir, y + ydir) = "*" THENπ DOπ IF RND > .5 THENπ xdir = 1π ydir = 0π ELSEπ ydir = 1π xdir = 0π END IFπ IF RND > .5 THEN xdir = -xdir: ydir = -ydirπ IF pf(x + xdir, y + ydir) <> "*" THEN EXIT DOπ LOOPπ END IFπEND IFπpx = px + xdir * speedπpy = py + ydir * speedπIF px > 309 THEN px = 1πIF CINT(px) = 0 THEN px = 304πframe = frame + 1: IF frame = 2 THEN frame = 0πIF frame = 0 THENπ IF PowerUp = 1 THENπ PUT (px, py), ZGhost1π ELSEπ PUT (px, py), gGhost1π END IFπELSEπ IF PowerUp = 1 THENπ PUT (px, py), ZGhost2π ELSEπ PUT (px, py), GGhost2π END IFπEND IFπPrevX = CINT(px)πPrevY = CINT(py)ππ gx = (px \ 8) + 1π gy = (py \ 8) + 1π IF gx = xx \ 8 + 1 AND gy = yy \ 8 + 1 THENπ IF PowerUp = 1 THENπ Score = Score + 200π UpdateScoreπ FOR s = 37 TO 5000 STEP 500π SOUND s, 1π NEXTπ flag = 0π ELSEπ death = 1π END IFπ END IFπEND SUBππ'Makes Pacman eat himself.π'πSUB KillPacπLINE (xx - 1, yy)-(xx + 10, yy + 8), 0, BF 'Blank out backgroundπPUT (xx - 1, yy - 1), PacGraph 'Put the PacCircle thereπfreq = 1500 'Sound valuesπfreq2 = 500πFOR y = -5 TO 5 STEP .2π LINE (xx + 4, yy + 5)-(xx + 4 + SQR(25 - y ^ 2), yy + 5 + y), 0π LINE (xx + 4, yy + 5)-(xx + 4 - SQR(25 - y ^ 2), yy + 5 + y), 0π '^ Wow! I actually found a use for grade 12 math!π SOUND freq, .5π SOUND freq2, .5π freq = freq - 10π freq2 = freq2 + 10πNEXTπEND SUBππSUB pacprint (y, text$)πDontCallGhosts = 1πyy = y * 8 - 8πx = 20 - LEN(text$) \ 2πxx = x * 8 - 7πFOR letter = 1 TO LEN(text$)π FOR xx = xx TO xx + 7π DrawPac xx, yy, 2π NEXTπ LOCATE y, xπ x = x + 1π PRINT MID$(text$, letter, 1)π SOUND 800, .25π SOUND 900, .25πNEXTπDontCallGhosts = 0πEND SUBππ'For comments, see BlueGhost subπSUB RedGhostπSTATIC frame, PrevX, PrevY, flag, px, py, xdir, ydirπIF flag = 0 THENπ flag = 1π PrevX = 17 * 8 - 8π PrevY = 12 * 8 - 8π px = PrevXπ py = PrevYπ xdir = 1π ydir = 0πEND IFπIF PowerUp = 1 THENπ speed = .5πELSEπ speed = 1πEND IFππLINE (PrevX, PrevY)-(PrevX + 10, PrevY + 9), 0, BFππIF px MOD 8 = 0 AND py MOD 8 = 0 THENπ x = (px \ 8) + 1π y = (py \ 8) + 1π IF pf(x - xdir, y - ydir) = "." THENπ xp = CINT(px) - 8 * xdirπ yp = CINT(py) - 8 * ydirπ LINE (xp + 3, yp + 4)-(xp + 5, yp + 5), 14, Bπ ELSEIF pf(x - xdir, y - ydir) = "o" THENπ xp = CINT(px) - 8 * xdirπ yp = CINT(py) - 8 * ydirπ CIRCLE (xp + 4, yp + 4), 3, 14π PAINT (xp + 4, yp + 4), 14, 14π END IFπ IF pf(x, y + 1) <> "*" THEN free = free + 1π IF pf(x + 1, y) <> "*" THEN free = free + 1π IF pf(x, y - 1) <> "*" THEN free = free + 1π IF pf(x - 1, y) <> "*" THEN free = free + 1π IF free > 2 OR pf(x + xdir, y + ydir) = "*" THENπ DOπ IF RND > .5 THENπ xdir = 1π ydir = 0π ELSEπ ydir = 1π xdir = 0π END IFπ IF RND > .5 THEN xdir = -xdir: ydir = -ydirπ IF pf(x + xdir, y + ydir) <> "*" THEN EXIT DOπ LOOPπ END IFπEND IFπpx = px + xdir * speedπpy = py + ydir * speedπIF px > 309 THEN px = 1πIF CINT(px) = 0 THEN px = 304πframe = frame + 1: IF frame = 2 THEN frame = 0πIF frame = 1 THENπ IF PowerUp = 1 THENπ PUT (px, py), ZGhost1π ELSEπ PUT (px, py), rGhost1π END IFπELSEπ IF PowerUp = 1 THENπ PUT (px, py), ZGhost2π ELSEπ PUT (px, py), rGhost2π END IFπEND IFπPrevX = CINT(px)πPrevY = CINT(py)ππ gx = (px \ 8) + 1π gy = (py \ 8) + 1π IF gx = xx \ 8 + 1 AND gy = yy \ 8 + 1 THENπ IF PowerUp = 1 THENπ Score = Score + 200π UpdateScoreπ FOR s = 37 TO 5000 STEP 500π SOUND s, 1π NEXTπ flag = 0π ELSEπ death = 1π END IFπ END IFπEND SUBππSUB UpdateScoreπLOCATE 24, 1πCOLOR 15πPRINT Score;πEND SUBππRobert Anthony Moreno SUPER GALATIC WARS alt.lang.basic 07-27-96 (00:00) QB, QBasic, PDS 402 10961 GALATIC.BAS 'Robert Anthony Moreno IIπ'Bob666@concentric.netπRANDOMIZE TIMERπDEFINT A-ZπDIM baddirection(10)πDIM badshoot(10)πDIM badshooting(10)πDIM badshotx(10)πDIM badshoty(10)πDIM badx(10)πDIM bady(10)πDIM dead(10)πDIM shooting(10)πDIM shotx(10)πDIM shoty(10)πDIM starc(100)πDIM stars(100)πDIM stari(100)πDIM starx(100)πDIM stary(100)πCLSπLOCATE 11, 26, 0πCOLOR 11, 0πPRINT "Moreno Computer Development!"πLOCATE 13, 26, 0πCOLOR 12, 0πPRINT " P r e s e n t s . . . "πSLEEP 3πstart:πdelay = VAL(COMMAND$)πIF delay = 0 THEN delay = 1000πSCREEN 13πCLSπPALETTE 31, 0πPALETTE 32, 0πLOCATE 11, 12, 0πCOLOR 31πPRINT "Super"πLOCATE 12, 15, 0πCOLOR 32πPRINT "Galactic Wars"πFOR c = 0 TO 63π PALETTE 32, cπNEXT cπFOR c = 0 TO 63π PALETTE 31, cπNEXT cπPLAY "MBL25CDEFGAB"πSLEEP 1πPALETTE 1, (63 * 1) + (63 * 256) + (63 * 65536)πPALETTE 2, (55 * 1) + (55 * 256) + (55 * 65536)πPALETTE 3, (45 * 1) + (45 * 256) + (45 * 65536)πPALETTE 4, (40 * 1) + (40 * 256) + (40 * 65536)πPALETTE 8, (50 * 1) + (25 * 256) + (25 * 65536)πPALETTE 9, (25 * 1) + (25 * 256) + (25 * 65536)πPALETTE 10, (40 * 1) + (40 * 256) + (40 * 65536)πPALETTE 11, (20 * 1) + (20 * 256) + (63 * 65536)πPALETTE 12, (63 * 1) + (0 * 256) + (0 * 65536)πPALETTE 20, 0πPALETTE 21, 20πPALETTE 22, 30πPALETTE 23, 40πPALETTE 24, 50πPALETTE 25, 60πFOR i = 100 TO 110π PALETTE i, 0πNEXT iπCOLOR 11πDOπ IF t = 0 THENπ d = 0π c = 0π END IFπ IF t = 100 THENπ d = 1π c = 11π END IFπ IF d = 0 THEN t = t + 1π IF d = 1 THEN t = t - 1π COLOR cπ LOCATE 15, 10, 0π PRINT "Press Enter To Start"πLOOP UNTIL INKEY$ = CHR$(13)πDO: LOOP UNTIL INKEY$ = ""πCLSπFOR i = 0 TO 100π starx(i) = (RND * 320)π stary(i) = (RND * 179) + 10π stars(i) = (RND * 3) + 2π starc(i) = (RND * 3) + 1πNEXT iπFOR i = 1 TO 10π badx(i) = (RND * 195) + 100π bady(i) = (RND * 150) + 25π baddirection(i) = (RND * 3) + 1πNEXT iπCOLOR 1πshield = 5πx = 40πy = 100πLINE (0, 9)-(320, 9), 1πLINE (0, 190)-(320, 190), 1πLOCATE 25, 1, 0πPRINT "<Esc> Exit : <P> Pause";πLOCATE 1, 1, 0πPRINT " Shields:"; shield; " Score:"; scoreπDOπ FOR i = 1 TO 100π PSET (starx(i), stary(i)), 0π stari(i) = stari(i) + 1π IF stari(i) = stars(i) THENπ starx(i) = starx(i) - 1π stari(i) = 0π END IFπ IF starx(i) < 0 THENπ starx(i) = (RND * 50) + 320π stary(i) = (RND * 179) + 10π stars(i) = (RND * 3) + 2π starc(i) = (RND * 3) + 1π END IFπ PSET (starx(i), stary(i)), starc(i)π NEXT iπ key$ = INKEY$π SELECT CASE UCASE$(key$)π CASE CHR$(27): GOTO quitπ CASE "P"π LOCATE 25, 1, 0π PRINT STRING$(40, CHR$(32));π LOCATE 25, 1, 0π PRINT "Game Paused... Press Enter";π DO: LOOP UNTIL INKEY$ = CHR$(13)π LOCATE 25, 1, 0π PRINT STRING$(40, CHR$(32));π LOCATE 25, 1, 0π PRINT "<Esc> Exit : <P> Pause";π CASE CHR$(13): IF shooting = 0 THEN shoot = 1π CASE CHR$(0) + "H": direction = 1π CASE CHR$(0) + "P": direction = 2π CASE CHR$(0) + "K": direction = 3π CASE CHR$(0) + "M": direction = 4π CASE CHR$(32): direction = 0π END SELECTπ LINE (x + 7, y - 4)-(x - 4, y - 4), 0π LINE (x + 7, y + 4)-(x - 4, y + 4), 0π LINE (x + 6, y - 3)-(x + 6, y + 3), 0π LINE (x + 7, y - 3)-(x + 7, y + 3), 0π LINE (x + 8, y - 3)-(x + 8, y + 3), 0π LINE (x + 1, y)-(x - 2, y - 3), 0π LINE (x + 1, y)-(x - 2, y + 3), 0π LINE (x - 4, y - 3)-(x + 3, y - 3), 0π LINE (x - 4, y + 3)-(x + 3, y + 3), 0π LINE (x - 1, y)-(x + 5, y), 0π CIRCLE (x, y), 10, 0, , , .6π IF direction = 1 AND y > 25 THEN y = y - 1π IF direction = 2 AND y < 174 THEN y = y + 1π IF direction = 3 AND x > 25 THEN x = x - 1π IF direction = 4 AND x < 295 THEN x = x + 1π IF direction = 1 OR direction = 2 THENπ IF y = 25 THEN direction = 0π IF y = 174 THEN direction = 0π END IFπ IF direction = 3 OR direction = 4 THENπ IF x = 25 THEN direction = 0π IF x = 295 THEN direction = 0π END IFπ LINE (x + 7, y - 4)-(x - 4, y - 4), 100π LINE (x + 7, y + 4)-(x - 4, y + 4), 100π LINE (x + 6, y - 3)-(x + 6, y + 3), 100π LINE (x + 7, y - 3)-(x + 7, y + 3), 100π LINE (x + 8, y - 3)-(x + 8, y + 3), 100π LINE (x + 1, y)-(x - 2, y - 3), 9π LINE (x + 1, y)-(x - 2, y + 3), 9π LINE (x - 4, y - 3)-(x + 3, y - 3), 11π LINE (x - 4, y + 3)-(x + 3, y + 3), 11π LINE (x - 1, y)-(x + 5, y), 10π CIRCLE (x, y), 10, (shield + 20), , , .6π IF shoot = 1 THENπ FOR i = 1 TO 10π IF shooting(i) = 0 THENπ shooting(i) = 1π shotx(i) = x + 8π shoty(i) = yπ SOUND 100, .05π EXIT FORπ END IFπ NEXT iπ shoot = 0π END IFπ FOR ii = 1 TO 10π IF shooting(ii) = 1 THENπ PSET (shotx(ii), shoty(ii)), 0π shotx(ii) = shotx(ii) + 2π IF shotx(ii) > 320 THEN shooting(ii) = 0π pixel = POINT(shotx(ii), shoty(ii))π IF pixel > 100 THENπ die = pixel - 100π FOR i = 1 TO 10π CIRCLE (badx(die), bady(die)), i, 12π NEXT iπ PLAY "MFL50DC"π FOR i = 1 TO 10π CIRCLE (badx(die), bady(die)), i, 0π SOUND 100, .05π NEXT iπ score = score + (badx(die) - x)π LOCATE 1, 1, 0π PRINT " Shields:"; shield; " Score:"; scoreπ i = dieπ PSET (shotx(ii), shoty(ii)), 0π LINE (badx(i) - 7, bady(i) + 4)-(badx(i) + 4, bady(i) + 4), 0π LINE (badx(i) - 7, bady(i) - 4)-(badx(i) + 4, bady(i) - 4), 0π LINE (badx(i) - 6, bady(i) + 3)-(badx(i) - 6, bady(i) - 3), 0π LINE (badx(i) - 7, bady(i) + 3)-(badx(i) - 7, bady(i) - 3), 0π LINE (badx(i) - 8, bady(i) + 3)-(badx(i) - 8, bady(i) - 3), 0π LINE (badx(i) + 3, bady(i) + 3)-(badx(i) - 3, bady(i) - 3), 0π LINE (badx(i) + 3, bady(i) - 3)-(badx(i) - 3, bady(i) + 3), 0π LINE (badx(i) - 5, bady(i))-(badx(i) + 2, bady(i)), 0π dead(i) = 1π shotx(ii) = 325π END IFπ PSET (shotx(ii), shoty(ii)), 12π END IFπ NEXT iiπ FOR i = 1 TO 10π IF dead(i) = 0 THENπ IF badshooting(i) = 0 AND x < badx(i) THENπ IF y > bady(i) AND direction = 1 THENπ IF (y - bady(i)) * 2 <= (badx(i) - x) THEN badshoot(i) = 1π END IFπ IF y < bady(i) AND direction = 2 THENπ IF (bady(i) - y) * 2 <= (badx(i) - x) THEN badshoot(i) = 1π END IFπ IF y = bady(i) AND direction = 0 THEN badshoot(i) = 1π END IFπ IF badshoot(i) = 1 THENπ badshooting(i) = 1π badshotx(i) = badx(i) - 8π badshoty(i) = bady(i)π badshoot(i) = 0π SOUND 100, .05π END IFπ LINE (badx(i) - 7, bady(i) + 4)-(badx(i) + 4, bady(i) + 4), 0π LINE (badx(i) - 7, bady(i) - 4)-(badx(i) + 4, bady(i) - 4), 0π LINE (badx(i) - 6, bady(i) + 3)-(badx(i) - 6, bady(i) - 3), 0π LINE (badx(i) - 7, bady(i) + 3)-(badx(i) - 7, bady(i) - 3), 0π LINE (badx(i) - 8, bady(i) + 3)-(badx(i) - 8, bady(i) - 3), 0π LINE (badx(i) + 3, bady(i) + 3)-(badx(i) - 3, bady(i) - 3), 0π LINE (badx(i) + 3, bady(i) - 3)-(badx(i) - 3, bady(i) + 3), 0π LINE (badx(i) - 5, bady(i))-(badx(i) + 2, bady(i)), 0π IF baddirection(i) = 1 AND bady(i) > 25 THEN bady(i) = bady(i) - 1π IF baddirection(i) = 2 AND bady(i) < 174 THEN bady(i) = bady(i) + 1π IF baddirection(i) = 3 AND badx(i) > 100 THEN badx(i) = badx(i) - 1π IF baddirection(i) = 4 AND badx(i) < 295 THEN badx(i) = badx(i) + 1π r = (RND * 4)π IF baddirection(i) = r THEN baddirection(i) = (RND * 4)π IF i <= 5 THENπ IF direction = 0 AND x < badx(i) THENπ IF y < bady(i) THEN baddirection(i) = 1π IF y > bady(i) THEN baddirection(i) = 2π IF y = bady(i) THEN baddirection(i) = 0π END IFπ FOR ii = 1 TO 10π IF shotx(ii) > badx(i) - 25 AND shotx(ii) < badx(i) + 10 THENπ IF shoty(ii) > bady(i) AND shoty(ii) < bady(i) + 25 THEN baddirection(i) = 1π IF shoty(ii) < bady(i) AND shoty(ii) > bady(i) - 25 THEN baddirection(i) = 2π IF shoty(ii) = bady(i) THEN baddirection(i) = ((RND * 1) + 1)π END IFπ NEXT iiπ END IFπ LINE (badx(i) - 7, bady(i) + 4)-(badx(i) + 4, bady(i) + 4), (100 + i)π LINE (badx(i) - 7, bady(i) - 4)-(badx(i) + 4, bady(i) - 4), (100 + i)π LINE (badx(i) - 6, bady(i) + 3)-(badx(i) - 6, bady(i) - 3), (100 + i)π LINE (badx(i) - 7, bady(i) + 3)-(badx(i) - 7, bady(i) - 3), (100 + i)π LINE (badx(i) - 8, bady(i) + 3)-(badx(i) - 8, bady(i) - 3), (100 + i)π LINE (badx(i) + 3, bady(i) + 3)-(badx(i) - 3, bady(i) - 3), 11π LINE (badx(i) + 3, bady(i) - 3)-(badx(i) - 3, bady(i) + 3), 11π LINE (badx(i) - 5, bady(i))-(badx(i) + 2, bady(i)), 8π IF POINT(x + 8, y - 4) = (100 + i) THENπ FOR ii = 1 TO 10π CIRCLE (x, y), ii, 12π NEXT iiπ PLAY "MFL50C"π FOR ii = 1 TO 10π CIRCLE (x, y), ii, 0π SOUND 100, .5π NEXT iiπ GOTO loseπ END IFπ IF POINT(x + 8, y + 4) = (100 + i) THENπ FOR ii = 1 TO 10π CIRCLE (x, y), ii, 12π NEXT iiπ PLAY "MFL50C"π FOR ii = 1 TO 10π CIRCLE (x, y), ii, 0π SOUND 100, .5π NEXT iiπ GOTO loseπ END IFπ IF POINT(x - 4, y - 4) = (100 + i) THENπ FOR ii = 1 TO 10π CIRCLE (x, y), ii, 12π NEXT iiπ PLAY "MFL50C"π FOR ii = 1 TO 10π CIRCLE (x, y), ii, 0π SOUND 100, .5π NEXT iiπ GOTO loseπ END IFπ IF POINT(x - 4, y + 4) = (100 + i) THENπ FOR ii = 1 TO 10π CIRCLE (x, y), ii, 12π NEXT iiπ PLAY "MFL50C"π FOR ii = 1 TO 10π CIRCLE (x, y), ii, 0π SOUND 100, .5π NEXT iiπ GOTO loseπ END IFπ END IFπ IF badshooting(i) = 1 THENπ PSET (badshotx(i), badshoty(i)), 0π badshotx(i) = badshotx(i) - 2π IF badshotx(i) < 0 THEN badshooting(i) = 0π pixel = POINT(badshotx(i), badshoty(i))π IF pixel = 100 THENπ PSET (badshotx(i), badshoty(i)), 0π shield = shield - 1π badshotx(i) = -5π IF shield = -1 THENπ FOR ii = 1 TO 10π CIRCLE (x, y), ii, 12π NEXT iiπ PLAY "MFL50C"π FOR ii = 1 TO 15π CIRCLE (x, y), ii, 0π SOUND 100, .5π NEXT iiπ END IFπ IF shield = 0 THEN PLAY "MBL25DCDCDC" ELSE PLAY "MBL25C"π LOCATE 1, 1, 0π PRINT " Shields:"; shield; " Score:"; scoreπ END IFπ PSET (badshotx(i), badshoty(i)), 12π END IFπ done = done + dead(i)π NEXT iπ IF done = 10 THEN GOTO win ELSE done = 0π IF shield = -1 THEN GOTO loseπ FOR i = 0 TO 50π FOR ii = 0 TO delay: NEXT iiπ NEXT iπLOOPπwin:πPLAY "MBL25CDEFGAB"πCLSπLOCATE 11, 18, 0πPRINT "Wow!"πLOCATE 12, 16, 0πPRINT "You Won!"πLOCATE 14, 15, 0πPRINT "Press Esc"πDO: LOOP UNTIL INKEY$ = CHR$(27)πCLSπLOCATE 11, 11πPRINT "Play Again? (Y,N):"πpa$ = INPUT$(1)πIF UCASE$(pa$) = "Y" THENπ CLEARπ GOTO startπEND IFπENDπlose:πPLAY "MBL25BAGFEDC"πCLSπLOCATE 11, 16, 0πPRINT "Ha Ha Ha"πLOCATE 12, 16, 0πPRINT "You Died"πLOCATE 14, 15, 0πPRINT "Press Esc"πDO: LOOP UNTIL INKEY$ = CHR$(27)πCLSπLOCATE 11, 11πPRINT "Play Again? (Y,N):"πpa$ = INPUT$(1)πIF UCASE$(pa$) = "Y" THENπ CLEARπ GOTO startπEND IFπENDπquit:πPLAY "MBL25BAGFEDC"πCLSπLOCATE 11, 4, 0πPRINT "Quiters Never Amount To Anything!"πLOCATE 13, 15, 0πPRINT "Press Enter"πDO: LOOP UNTIL INKEY$ = CHR$(13)πENDπJonathan Leger HEX-ALIGN 4X4 PUZZEL leger@mail.dtx.net 08-06-96 (21:22) QB, QBasic, PDS 1022 30239 PUZZEL.BAS DEFINT A-ZππDECLARE SUB Center (s$, l%)πDECLARE SUB PlayPuzzel ()πDECLARE SUB ShowPuzzel ()πDECLARE SUB LoadPuzzel ()πDECLARE SUB CheckHighScore (move.count%)πDECLARE FUNCTION CheckPuzzel ()ππDECLARE SUB ABSOLUTE (var1%, var2%, var3%, var4%, var5%, var6%, offset%)ππ'== BEGIN HEADER ==π'mouse constantsπCONST LB = &H1 'constant for left buttonπCONST RB = &H2 'constant for right buttonπCONST CB = &H4 'constant for center buttonπCONST DC = &H8 'constant for double click (reserved for next release)π'mouse control functionsπDECLARE FUNCTION mouse.enable% ()πDECLARE SUB mouse.disable ()πDECLARE SUB mouse.show ()πDECLARE SUB mouse.hide ()πDECLARE FUNCTION mouse.loadGCR$ (filename$)πDECLARE FUNCTION mouse.loadTCR$ (filename$)π'setsπDECLARE SUB mouse.setpos (x%, y%)πDECLARE SUB mouse.setlimit (x1%, y1%, x2%, y2%)πDECLARE SUB mouse.setspeed (speed.x%, speed.y%) 'limit: -32,768 to 32,767πDECLARE SUB mouse.setGCR (data$)πDECLARE SUB mouse.setTCR (data$)π'getsπDECLARE SUB mouse.get (x%, y%, buttons%)πDECLARE SUB mouse.getpos (x%, y%)πDECLARE SUB mouse.getmovement (x%, y%)πDECLARE SUB mouse.getlastdown (mouse.constant%, x%, y%)πDECLARE SUB mouse.getlastup (mouse.constant%, x%, y%)πDECLARE FUNCTION mouse.getbutton% ()π'shift state constantsπCONST shift = &H3πCONST CTRL = &H4πCONST ALT = &H8π'shift state functionπDECLARE FUNCTION shift.getstate% ()π'== END HEADER ==ππIF NOT mouse.enable THENπ PRINT "This program requires a mouse."π ENDπEND IFππmouse.showππCONST TRUE = -1πCONST FALSE = NOT TRUEππDIM SHARED puzzel(1 TO 16), pcos(1 TO 16, 1 TO 2), high.score, move.countππPlayPuzzelππSUB Center (s$, l)ππstring.size = LEN(s$)πper.loc = INSTR(1, s$, "%%")πDO UNTIL per.loc = 0π string.size = string.size - 3π per.loc = INSTR(per.loc + 1, s$, "%%")πLOOPππLOCATE l, ((80 - string.size) / 2)ππper.loc = INSTR(1, s$, "%%")πDO UNTIL per.loc = 0π left.string$ = LEFT$(s$, per.loc - 1)π string.color = VAL("&H" + MID$(s$, per.loc + 2, 1))π right.string$ = RIGHT$(s$, LEN(s$) - per.loc - 2)π s$ = right.string$π PRINT left.string$;π COLOR string.colorπ per.loc = INSTR(1, s$, "%%")πLOOPπPRINT right.string$;ππEND SUBππSUB CheckHighScore (move.count)ππhsfile = FREEFILEπOPEN "puzzel.hsc" FOR BINARY AS hsfileππIF LOF(hsfile) = 0 THENπ CLOSE hsfileπ OPEN "puzzel.hsc" FOR OUTPUT AS hsfileπ move.count = move.count XOR 32767π PRINT #1, move.countπ CLOSE hsfileπELSEπ CLOSE hsfileπ OPEN "puzzel.hsc" FOR INPUT AS hsfileπ INPUT #hsfile, high.scoreπ high.score = high.score XOR 32767π IF move.count < high.score THENπ CLOSE hsfileπ OPEN "puzzel.hsc" FOR OUTPUT AS hsfileπ move.count = move.count XOR 32767π PRINT #1, move.countπ END IFπ CLOSE hsfileπEND IFππEND SUBππFUNCTION CheckPuzzelππFOR piece = 1 TO 15π IF puzzel(piece) <> piece THENπ CheckPuzzel = FALSEπ EXIT FUNCTIONπ END IFπNEXT pieceππCheckPuzzel = TRUEππEND FUNCTIONππSUB LoadPuzzelππpuzzel$ = "123456789ABCDEF"ππRANDOMIZE TIMERππFOR piece = 1 TO 15π ploc = INT(RND * LEN(puzzel$)) + 1π temp$ = MID$(puzzel$, ploc, 1)π puzzel$ = LEFT$(puzzel$, ploc - 1) + RIGHT$(puzzel$, LEN(puzzel$) - ploc)π puzzel(piece) = VAL("&H" + temp$)πNEXT pieceππpiece = 0πFOR y = 1 TO 4π FOR x = 1 TO 4π piece = piece + 1π pcos(piece, 1) = 27 + (x * 5)π pcos(piece, 2) = 9 + ((y - 1) * 2)π NEXT xπNEXT yππpuzzel(16) = 0ππhsfile = FREEFILEπOPEN "puzzel.hsc" FOR BINARY AS hsfileππIF LOF(hsfile) = 0 THENπ CLOSE hsfileπ OPEN "puzzel.hsc" FOR OUTPUT AS hsfileπ PRINT #1, 32767 XOR 32767π high.score = 32767π CLOSE hsfileπELSEπ CLOSE hsfileπ OPEN "puzzel.hsc" FOR INPUT AS hsfileπ INPUT #1, high.scoreπ high.score = high.score XOR 32767π CLOSE hsfileπEND IFππEND SUBππDEFSNG A-Zπ'Disable mouse.π'EXAMPLE:π' enabled% = mouse.enable 'enable mouseπ' mouse.show 'show mouseπ' a$ = INPUT$(1) 'pauseπ' mouse.disable 'disable mouseπSUB mouse.disableπ SHARED mouse.exist AS INTEGERπ IF mouse.exist THENπ mouse.hideπ mouse.exist = 0π END IFπEND SUBππ'Enable mouse for usage. Must be run before any mouse functions (other thanπ'cursor-loading functions) or none will work.π'RETURN:π' -1 (&hFFFF) if mouse found, else 0.π'EXAMPLE:π' IF NOT mouse.enable THEN PRINT "No mouse" ELSE PRINT "Mouse found"πFUNCTION mouse.enable%π SHARED mouse.exist AS INTEGERππ 'store machine language dataπ SHARED mouse.asm$π mouse.asm$ = ""π mouse.asm$ = mouse.asm$ + CHR$(&H55) 'push bpπ mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&HE5) 'mov bp, spπ mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE) 'mov bx, [bp+0e]π mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H7) 'mov ax, [bx]π mouse.asm$ = mouse.asm$ + CHR$(&H50) 'push axπ mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC) 'mov bx, [bp+0c]π mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H7) 'mov cx, [ax]π mouse.asm$ = mouse.asm$ + CHR$(&H50) 'push axπ mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'mov bx, [bp+0a]π mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&HF) 'mov cx, [bx]π mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx, [bp+08]π mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H17) 'mov dx, [bx]π' mouse.asm$ = mouse.asm$ + CHR$(&H1E) 'push dsπ' mouse.asm$ = mouse.asm$ + CHR$(&H7) 'pop esπ mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'mov bx, [bp+06]π mouse.asm$ = mouse.asm$ + CHR$(&H8E) + CHR$(&H7) 'mov es, [bx]π mouse.asm$ = mouse.asm$ + CHR$(&H5B) 'pop bxπ mouse.asm$ = mouse.asm$ + CHR$(&H58) 'pop axπ mouse.asm$ = mouse.asm$ + CHR$(&HCD) + CHR$(&H33) 'int 33hπ mouse.asm$ = mouse.asm$ + CHR$(&H53) 'push bxπ mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE) 'mov bx, [bp+0e]π mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H7) 'mov [bx], axπ mouse.asm$ = mouse.asm$ + CHR$(&H58) 'pop axπ mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC) 'mov bx, [bp+0c]π mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H7) 'mov [bx], axπ mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'mov bx, [bp+0a]π mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&HF) 'mov [bx], cxπ mouse.asm$ = mouse.asm$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'mov bx, [bp+08]π mouse.asm$ = mouse.asm$ + CHR$(&H89) + CHR$(&H17) 'mov [bx], dxπ mouse.asm$ = mouse.asm$ + CHR$(&H5D) 'pop bpπ mouse.asm$ = mouse.asm$ + CHR$(&HCA) + CHR$(&HA) + CHR$(&H0) 'retf 10ππ 'initialize and check mouse existanceπ mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π ax% = 0π DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, ax%, 0, 0, 0, 0, mouse.asmoff%)π DEF SEGπ mouse.exist = ax%ππ mouse.enable = mouse.existπEND FUNCTIONππ'Gets mouse status (coordinates and button status.)π'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* x% = integer variable to store x coordinateπ'* y% = integer variable to store y coordinateπ'* buttons% = integer variable to store buttons status where:π' * buttons% becomes LB if left button is pressedπ' * buttons% becomes RB if right button is pressedπ' * buttons% becomes CB if center buttons is pressedπ' * or combination (left button and right button makes buttons% = LB + RB)π' including double clicks (ie - LB + DC).π'* LB, RB, and CB are mouse constants found in the main module.π'EXAMPLE:π' CLSπ' enabled% = mouse.enableπ' mouse.showπ' DOπ' mouse.get x%, y%, buttons%π' LOCATE 1, 1: PRINT USING "#### #### ####"; x%; y%; buttons%π' LOOP WHILE INKEY$ = ""π' mouse.disableπSUB mouse.get (x%, y%, buttons%)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H3, bx%, x%, y%, 0, mouse.asmoff%)π DEF SEGπ END IFπ buttons% = 0π IF bx% AND &H1 THEN buttons% = buttons% OR LBπ IF bx% AND &H2 THEN buttons% = buttons% OR RBπ IF bx% AND &H4 THEN buttons% = buttons% OR CBπEND SUBππ'Gets the status of mouse buttons.π'COMMENT:π'* Using mouse.get() function is recommended instead when using bothπ' mouse.getbutton() and mouse.getpos() functions.π'RETURN:π'* An integer value:π' * LB for Left Buttonπ' * RB for Right Buttonπ' * CB for Center Button (if any)π' * or combination (left button and right button makes buttons% = LB + RB)π' including double clicks (ie - LB + DC).π'* LB, RB, and CB are mouse constants found in the main module.π'EXAMPLE:π' CLSπ' enabled% = mouse.enableπ' mouse.showπ' DOπ' buttons% = mouse.getbuttonπ' LOCATE 1, 1: PRINT USING "####"; buttons%π' LOOP WHILE INKEY$ = ""π' mouse.disableπFUNCTION mouse.getbutton%π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H3, bx%, 0, 0, 0, mouse.asmoff%)π DEF SEGπ END IFπ ret% = 0π IF bx% AND &H1 THEN ret% = ret% OR LBπ IF bx% AND &H2 THEN ret% = ret% OR RBπ IF bx% AND &H4 THEN ret% = ret% OR CBπ mouse.getbutton% = ret%πEND FUNCTIONππ'Gets the last coordinate where a mouse button was pressedπ'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* mouse.constant% is a mouse constant of LB (left button), RB (rightπ' button), or CB (center button) for button press check. No combinationπ' allowed. Any values other than LB, RB, and CB will default to LB.π'* x% and y% are the variables to store x and y corrdinates where the mouseπ' button was pressed.π'EXAMPLE:π' CLSπ' enabled% = mouse.enableπ' mouse.showπ' DOπ' mouse.getlastdown LB, x%, y%π' LOCATE 1, 1: PRINT USING "#### ####"; x%; y%π' LOOP WHILE INKEY$ = ""π' mouse.disableπSUB mouse.getlastdown (mouse.constant%, x%, y%)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ SELECT CASE mouse.constant%π CASE LB: button% = 0π CASE RB: button% = 1π CASE CB: button% = 2π CASE ELSE: button% = 0π END SELECTπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H5, button%, cx%, dx%, 0, mouse.asmoff%)π DEF SEGπ x% = cx%π y% = dx%π END IFπEND SUBππ'Gets the last coordinate where a mouse button was releasedπ'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* mouse.constant% is a mouse constant of LB (left button), RB (rightπ' button), or CB (center button) for button release check. No combinationπ' allowed.π'* x% and y% are the variables to store x and y corrdinates where the mouseπ' button was released.π'EXAMPLE:π' CLSπ' enabled% = mouse.enableπ' mouse.showπ' DOπ' mouse.getlastup LB, x%, y%π' LOCATE 1, 1: PRINT USING "#### ####"; x%; y%π' LOOP WHILE INKEY$ = ""π' mouse.disableπSUB mouse.getlastup (mouse.constant%, x%, y%)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ SELECT CASE mouse.constant%π CASE LB: button% = 0π CASE RB: button% = 1π CASE CB: button% = 2π CASE ELSE: button% = 0π END SELECTπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H6, button%, cx%, dx%, 0, mouse.asmoff%)π DEF SEGπ x% = cx%π y% = dx%π END IFπEND SUBππ'Gets the movement of the mouse since last callπ'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* x% and y% are variables to store the horizontal and vertical movements,π' respectively.π'* Right and Down are positives, Left and Up are negativesπ'EXAMPLE:π' CLSπ' enabled% = mouse.enableπ' mouse.showπ' DOπ' mouse.getmovement x%, y%π' LOCATE 1, 1: PRINT USING "#### ####"; x%; y%π' SLEEP 1π' LOOP WHILE INKEY$ = ""π' mouse.disableπSUB mouse.getmovement (x%, y%)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &HB, 0, cx%, dx%, 0, mouse.asmoff%)π DEF SEGπ x% = cx%π y% = dx%π END IFπEND SUBππ'Gets mouse coordinates.π'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'COMMENT:π'* Using mouse.get() function is recommended instead when using bothπ' mouse.getpos() and mouse.getbutton() functions.π'INPUT:π'* x% = integer variable to store x coordinateπ'* y% = integer variable to store y coordinateπ'EXAMPLE:π' CLSπ' enabled% = mouse.enableπ' mouse.showπ' DOπ' mouse.getpos x%, y%π' LOCATE 1, 1: PRINT USING "#### ####"; x%; y%π' LOOP WHILE INKEY$ = ""π' mouse.disableπSUB mouse.getpos (x%, y%)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H3, 0, x%, y%, 0, mouse.asmoff%)π DEF SEGπ x% = (x% / 8) + 1π y% = (y% / 8) + 1π END IFπEND SUBππ'Hides mouse cursorπ'EXAMPLE:π' enabled% = mouse.enable 'enable mouseπ' mouse.show 'show mouseπ' a$ = INPUT$(1) 'pauseπ' mouse.hide 'hide mouseπ' a$ = INPUT$(1) 'pauseπ' mouse.disable 'disable mouseπSUB mouse.hideπ SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π SHARED mouse.visible AS INTEGERπ IF mouse.exist AND mouse.visible THENπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H2, 0, 0, 0, 0, mouse.asmoff%)π DEF SEGπ mouse.visible = 0π END IFπEND SUBππ'Loads the graphics cursorπ'COMMENT:π'* Requies MS Mouse driver version 3.0 or compatibleπ'INPUT:π'* filename$ is the file name to input the graphics cursor's data from.π'* If filename$ has no extention, it defaults to .GCR (Graphics CuRsor)π' extention.π'RETURN:π'* Returns the graphics cursor data in the string form.π'EXAMPLE:π' SCREEN 9 'requires EGA or betterπ' enabled% = mouse.enableπ' mouse.showπ' data$ = mouse.loadGCR$("cursor.gcr")π' mouse.setGCR data$πFUNCTION mouse.loadGCR$ (filename$)π IF INSTR(filename$, ".") = 0 THEN filename$ = filename$ + ".GCR"ππ filenumber% = FREEFILEπ OPEN filename$ FOR BINARY AS filenumber%π strn$ = SPACE$(3)π GET #filenumber%, 1, strn$π IF strn$ = "GCR" THENπ strn$ = SPACE$(69)π GET #filenumber%, 1, strn$π ELSE strn$ = ""π END IFπ CLOSE filenumber%π mouse.loadGCR$ = strn$πEND FUNCTIONππ'Loads the text cursorπ'COMMENT:π'* Requies MS Mouse driver version 3.0 or compatibleπ'INPUT:π'* filename$ is the file name to input the graphics cursor's data from.π'* If filename$ has no extention, it defaults to .TCR (Text CuRsor) extention.π'RETURN:π'* Returns the text cursor data in the string form.π'EXAMPLE:π' enabled% = mouse.enableπ' mouse.showπ' data$ = mouse.loadTCR$("cursor.tcr")π' mouse.setTCR data$πFUNCTION mouse.loadTCR$ (filename$)π IF INSTR(filename$, ".") = 0 THEN filename$ = filename$ + ".TCR"π π filenumber% = FREEFILEπ OPEN filename$ FOR BINARY AS filenumber%π strn$ = SPACE$(3)π GET #filenumber%, 1, strn$π IF strn$ = "TCR" THENπ strn$ = SPACE$(8)π GET #filenumber%, 1, strn$π ELSE strn$ = ""π END IFπ CLOSE filenumber%π mouse.loadTCR$ = strn$πEND FUNCTIONππ'Changes the graphics cursorπ'COMMENT:π'* Requies MS Mouse driver version 3.0 or compatibleπ'INPUT:π'* data$ is the graphics cursor data gotten from a file using the functionπ' mouse.loadGCR().π'EXAMPLE:π' SCREEN 9 'requires EGA or betterπ' enabled% = mouse.enableπ' mouse.showπ' data$ = mouse.loadGCR$("cursor.gcr")π' mouse.setGCR data$πSUB mouse.setGCR (data$)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist AND LEN(data$) = 69 AND LEFT$(data$, 3) = "GCR" THENπ 'get hotx valueπ hotxstr$ = MID$(data$, 68, 1)π DEF SEG = VARSEG(hotxstr$)π bx% = PEEK(SADD(hotxstr$))π DEF SEGπ 'get hoty valueπ hotystr$ = MID$(data$, 69, 1)π DEF SEG = VARSEG(hotystr$)π cx% = PEEK(SADD(hotystr$))π DEF SEGπ 'get image shape valuesπ dx% = SADD(data$) + 3π es% = VARSEG(data$)π 'executeπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H9, bx%, cx%, dx%, es%, mouse.asmoff%)π DEF SEGπ END IFπEND SUBππ'Sets a "boxed" area for the mouse to move around. It cannot go beyond.π'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'INPUT:π'* (x1%, y1%) is the top-left coordinate of the box.π'* (x2%, y2%) is the bottom-right coordinate of the box.π'EXAMPLE:π' enabled% = mouse.enableπ' mouse.showπ' mouse.setlimit 50, 50, 300, 100π' a$ = INPUT$(1) 'wait for a keyπ' mouse.disableπSUB mouse.setlimit (x1%, y1%, x2%, y2%)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ cx% = x1%π dx% = x2%π DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H7, 0, cx%, dx%, 0, mouse.asmoff%)π DEF SEGπ cx% = y1%π dx% = y2%π DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H8, 0, cx%, dx%, 0, mouse.asmoff%)π DEF SEGπ END IFπEND SUBππ'Moves the mouse position to (x%, y%)π'COMMENT:π'* Coordinates are in pixels, even if the screen is in text mode.π'NOTES:π'* The inputted values, x% and y%, must be in "pixels", not in "blocks", evenπ' in text mode.π'EXAMPLE:π' enabled% = mouse.enableπ' mouse.showπ' DOπ' mouse.setpos 100, 100π' SLEEP 1π' LOOP WHILE INKEY$ = ""π' mouse.disableπSUB mouse.setpos (x%, y%)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ cx% = x%π dx% = y%π DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H4, 0, cx%, dx%, 0, mouse.asmoff%)π DEF SEGπ END IFπEND SUBππ'Changes the mouse speedπ'COMMENT:π'* This interrupt service actually sets the ratio between mickey (the small-π' est movement the mouse can detect) and the pixels. This function doesπ' some calculations to make it simulate a speed setting interrupt service.π' There is aactually a speed setting interrupt service, but it is availableπ' to MS Mouse Driver version 6.0 and compatibles so I didn't want to doπ' that. All the functions in this QBASIC functions are MS Mouse Driver ver-π' sion 1.0 and compatible with the exception of graphics cursor settingπ' functions and text cursor setting functions.π'INPUT:π'* x% is the new horizontal mouse speedπ'* y% is the new vertical mouse speedπ'* The minimum value is -32,768 (go backwards) and the maximum value isπ' 32,767, same as the minimum and the maximum value limit of integers.π'EXAMPLE:π' enabled% = mouse.enableπ' mouse.showπ' mouse.setspeed &H7FFF, &H7FFFπ' a$ = INPUT$(1) 'wait for a keyπ' mouse.disableπSUB mouse.setspeed (x%, y%)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π IF mouse.exist THENπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &HF, 0, (x% XOR &H7FFF), (y% XOR &H7FFF), 0, mouse.asmoff%)π DEF SEGπ END IFπEND SUBππ'Changes the text cursorπ'COMMENT:π'* Requies MS Mouse driver version 3.0 or compatibleπ'INPUT:π'* data$ is the text cursor data gotten from a file using the functionπ' mouse.loadTCR().π'EXAMPLE:π' enabled% = mouse.enableπ' mouse.showπ' data$ = mouse.loadTCR$("cursor.tcr")π' mouse.setTCR data$πSUB mouse.setTCR (data$)π SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π π IF NOT (mouse.exist AND LEN(data$) = 8 AND LEFT$(data$, 3) = "TCR") THEN EXIT SUBπ π 'get cursor type valueπ cursortype$ = MID$(data$, 4, 1)π DEF SEG = VARSEG(cursortype$)π bx% = PEEK(SADD(cursortype$))π DEF SEGπ 'get arg1 valueπ arg1h$ = MID$(data$, 5, 1)π DEF SEG = VARSEG(arg1h$)π argh% = PEEK(SADD(arg1h$))π DEF SEGπ arg1l$ = MID$(data$, 6, 1)π DEF SEG = VARSEG(arg1l$)π argl% = PEEK(SADD(arg1l$))π DEF SEGπ cx% = (argh% AND &H7F) * &H100 + argl%π IF argh% AND &H80 THEN cx% = cx% OR &H8000π 'get arg2 valueπ arg2h$ = MID$(data$, 7, 1)π DEF SEG = VARSEG(arg2h$)π argh% = PEEK(SADD(arg2h$))π DEF SEGπ arg2l$ = MID$(data$, 8, 1)π DEF SEG = VARSEG(arg2l$)π argl% = PEEK(SADD(arg2l$))π DEF SEGπ dx% = (argh% AND &H7F) * &H100 + argl%π IF argh% AND &H80 THEN dx% = dx% OR &H8000π 'executeπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &HA, bx%, cx%, dx%, 0, mouse.asmoff%)π DEF SEGπEND SUBππ'Shows the mouse. Must have been enabled first.π'EXAMPLE:π' enabled% = mouse.enable 'enable mouseπ' mouse.show 'show mouseπ' a$ = INPUT$(1) 'pauseπ' mouse.disable 'disable mouseπSUB mouse.showπ SHARED mouse.exist AS INTEGERπ SHARED mouse.asm$π mouse.asmseg% = VARSEG(mouse.asm$)π mouse.asmoff% = SADD(mouse.asm$)π SHARED mouse.visible AS INTEGERπ IF mouse.exist AND NOT mouse.visible THENπ DEF SEG = mouse.asmseg%π CALL ABSOLUTE(dummy%, &H1, 0, 0, 0, 0, mouse.asmoff%)π DEF SEGπ mouse.visible = 1π END IFπEND SUBππDEFINT A-ZπSUB PlayPuzzelππSCREEN 0πWIDTH 80, 25πCLSππLoadPuzzelππCOLOR 10πCenter "%%9[ %%FHex%%B-%%FAlign %%9]", 1πCOLOR 7: LOCATE 10, 8: PRINT "Turn"πCOLOR 9: LOCATE 11, 5: PRINT "(";πCOLOR 11: PRINT "S";πCOLOR 9: PRINT ")";πCOLOR 7: PRINT "ound OFF"πCOLOR 8: LOCATE 12, 1: PRINT "[";πCOLOR 4: PRINT "Right Mouse Click";πCOLOR 8: PRINT "]"ππLOCATE 3, 1: COLOR 3πPRINT "[ The object of the game is to put all of the hexidecimal numbers in numerical ]"πPRINT "[ order (1 2 3 4 5 6 7 8 9 A B C D E F) in the fewest number of moves possible ]";ππCOLOR 8ππt$ = CHR$(218) + STRING$(20, 196) + CHR$(191)πm$ = CHR$(179) + STRING$(20, " ") + CHR$(179)πb$ = CHR$(192) + STRING$(20, 196) + CHR$(217)ππLOCATE 8, 29: PRINT t$πFOR y = 9 TO 16π LOCATE y, 29: PRINT m$πNEXT yπLOCATE 16, 29: PRINT b$ππShowPuzzelππlast.error# = TIMERπlast.sound.change# = TIMERπlast.error.loc = 0πmove.count = 0πsound.on = TRUEππDOππ mouse.getpos mouse.x, mouse.yπ button = mouse.getbuttonπ move.okay = FALSEπ in.grid = FALSEππ IF (button = 2 OR (mouse.x >= 5 AND mouse.x <= 7 AND mouse.y = 11 AND button = 1)) AND (TIMER - last.sound.change# > .25) THENπ last.sound.change# = TIMERπ IF sound.on THENπ sound.on = FALSEπ SCREEN , , , 1π mouse.hideπ COLOR 7π LOCATE 11, 13: PRINT "ON "π PCOPY 1, 0π mouse.showπ ELSEπ sound.on = TRUEπ mouse.hideπ SCREEN , , , 1π COLOR 7π LOCATE 11, 13: PRINT "OFF"π PCOPY 1, 0π mouse.showπ END IFπ END IFππ key$ = INKEY$π IF key$ <> "" THENπ SELECT CASE key$π CASE CHR$(27)π EXIT DOπ CASE "s", "S"π IF sound.on THENπ sound.on = FALSEπ SCREEN , , , 1π mouse.hideπ COLOR 7π LOCATE 11, 13: PRINT "ON "π PCOPY 1, 0π mouse.showπ ELSEπ sound.on = TRUEπ mouse.hideπ SCREEN , , , 1π COLOR 7π LOCATE 11, 13: PRINT "OFF"π PCOPY 1, 0π mouse.showπ END IFπ CASE CHR$(0) + CHR$(75) 'Left keyπ CASE CHR$(0) + CHR$(77) 'Right keyπ CASE CHR$(0) + CHR$(72) 'Up keyπ CASE CHR$(0) + CHR$(80) 'Down keyπ END SELECTπ ELSEπ FOR piece = 1 TO 16π IF (mouse.x >= pcos(piece, 1) - 1 AND mouse.x <= pcos(piece, 1) + 1) AND (mouse.y = pcos(piece, 2) AND button = 1) THENπ in.grid = TRUEπ IF piece > 1 THENπ IF puzzel(piece - 1) = 0 AND NOT (piece MOD 4 = 1) THENπ puzzel(piece - 1) = puzzel(piece)π puzzel(piece) = 0π IF sound.on THENπ FOR z = 100 TO 500 STEP 100π SOUND 100 + z, .5π NEXT zπ END IFπ move.okay = TRUEπ last.error# = TIMERπ move.count = move.count + 1π ShowPuzzelπ EXIT FORπ END IFπ END IFπ IF piece < 16 THENπ IF puzzel(piece + 1) = 0 AND piece MOD 4 THENπ puzzel(piece + 1) = puzzel(piece)π puzzel(piece) = 0π IF sound.on THENπ FOR z = 100 TO 500 STEP 100π SOUND 100 + z, .5π NEXT zπ END IFπ move.okay = TRUEπ last.error# = TIMERπ move.count = move.count + 1π ShowPuzzelπ EXIT FORπ END IFπ END IFπ IF piece < 13 THENπ IF puzzel(piece + 4) = 0 THENπ puzzel(piece + 4) = puzzel(piece)π puzzel(piece) = 0π IF sound.on THENπ FOR z = 100 TO 500 STEP 100π SOUND 100 + z, .5π NEXT zπ END IFπ move.okay = TRUEπ last.error# = TIMERπ move.count = move.count + 1π ShowPuzzelπ EXIT FORπ END IFπ END IFπ IF piece > 4 THENπ IF puzzel(piece - 4) = 0 THENπ puzzel(piece - 4) = puzzel(piece)π puzzel(piece) = 0π IF sound.on THENπ FOR z = 100 TO 500 STEP 100π SOUND 100 + z, .5π NEXT zπ END IFπ move.okay = TRUEπ last.error# = TIMERπ move.count = move.count + 1π ShowPuzzelπ EXIT FORπ END IFπ END IFπ END IFπ IF puzzel(piece) = 0 AND (mouse.x >= pcos(piece, 1) - 1 AND mouse.x <= pcos(piece, 1) + 1) AND (mouse.y = pcos(piece, 2) AND button = 1) THENπ move.okay = TRUEπ END IFπ NEXT pieceπ π IF sound.on THENπ IF NOT move.okay AND button = 1 AND NOT in.grid THENπ IF (TIMER - last.error# >= .25) THENπ SOUND 100, 3π last.error# = TIMERπ END IFπ ELSEIF NOT move.okay AND button = 1 AND in.grid THENπ IF (TIMER - last.error# >= .25) THENπ FOR z = 500 TO 1000 STEP 50π SOUND 500 + z, .1π NEXT zπ FOR z = 500 TO 1000 STEP 50π SOUND 500 + z, .1π NEXT zπ last.error# = TIMERπ END IFπ END IFπ END IFππ END IFππ IF CheckPuzzel = TRUE THENπ SCREEN , , , 1π COLOR 15π Center "You've won!", 19π CheckHighScore move.countπ ENDπ END IFππLOOPππEND SUBππDEFSNG A-Zπ'Gets shift state.π'RETURN:π'* 0 if no shift key pressedπ'* ALT if Alt key pressedπ'* CTRL if Ctrl key pressedπ'* SHIFT if Shift key pressedπ'* These may be in combination. For example, if Ctrl-Alt is pressed, thenπ' return is CTRL + ALT.π'* ALT, CTRL, and SHIFT are shift constants defined in the main module.π'EXAMPLE:π' CLSπ' enabled% = mouse.enableπ' mouse.showπ' DOπ' mouse.get x%, y%, buttons%π' shiftstate% = shift.getstate%π' IF buttons% THENπ' LOCATE 1, 1: PRINT SPACE$(79); : LOCATE 1, 1π' SELECT CASE shiftstate%π' CASE 0: PRINT "Mouse button was pressed without any shift keys."π' CASE ALT: PRINT "Mouse button and Alt key pressed."π' CASE CTRL: PRINT "Mouse button and Ctrl key pressed."π' CASE SHIFT: PRINT "Mouse button and Shift key pressed."π' END SELECTπ' END IFπ' LOOP WHILE INKEY$ = ""πFUNCTION shift.getstate%π DEF SEG = 0π state% = PEEK(&H417) AND &HFπ DEF SEGπ IF (state% AND &H3) THEN state% = (state% OR &H3)π shift.getstate% = state%πEND FUNCTIONππDEFINT A-ZπSUB ShowPuzzelππmouse.hideππPCOPY 0, 1πSCREEN , , 1ππCOLOR 3πpiece = 0πFOR y = 1 TO 4π FOR x = 1 TO 4π piece = piece + 1π LOCATE pcos(piece, 2), pcos(piece, 1) - 1π IF puzzel(piece) = 0 THENπ COLOR 7π PRINT "[■] "π COLOR 3π ELSEπ COLOR 3π PRINT "[";π COLOR 11π PRINT HEX$(puzzel(piece));π COLOR 3π PRINT "] "π END IFπ NEXT xπNEXT yππLOCATE 23, 20πCOLOR 14: PRINT "Best Score:";πCOLOR 12: PRINT high.scoreππLOCATE 23, 45πCOLOR 15: PRINT "Your Score:";πCOLOR 11: PRINT move.countππPCOPY 1, 0πSCREEN , , , 0ππmouse.showππEND SUBπAlex Makris WORLD CUP SOCCER '94 pages.prodigy.com/gamersp 04-06-96 (17:04) QB, QBasic, PDS 1430 62547 WC94.BAS 'No cool nicknames just By Alex(A|@*) Makris CRPY26C πDECLARE SUB USA : DECLARE SUB SWITZERLANDπDECLARE SUB ROMANIA : DECLARE SUB COLOMBIAπDECLARE SUB BRAZIL : DECLARE SUB CAMEROONπDECLARE SUB SWEDEN : DECLARE SUB RUSSIAπDECLARE SUB GERMANY : DECLARE SUB SPAINπDECLARE SUB SOUTHKOREA : DECLARE SUB BOLIVIAπDECLARE SUB ARGENTINA : DECLARE SUB NIGERIAπDECLARE SUB BULGARIA : DECLARE SUB GREECEπDECLARE SUB IRELAND : DECLARE SUB NORWAYπDECLARE SUB ITALY : DECLARE SUB MEXICOπDECLARE SUB BELGIUM : DECLARE SUB NETHERLANDSπDECLARE SUB SAUDIARABIA : DECLARE SUB MOROCCOπDECLARE SUB FLASHER : DECLARE SUB INTROπDECLARE SUB LOGO : DECLARE SUB LOGOCOVERπDECLARE SUB MENU : DECLARE SUB LOGOFLASHπDECLARE SUB LOGOLETTERCOVER : DECLARE SUB STRIKERπDECLARE SUB SOCCERFIELD : DECLARE SUB PLAYERπDECLARE SUB INSTRUCTIONS : DECLARE SUB CONTROLSπDECLARE SUB SELECTION : DECLARE SUB DEMOπDECLARE SUB MAINGAME : DECLARE SUB DRAWSTUFFπDECLARE SUB INTERPRET : DECLARE SUB GOALπ πUSANAME1$ = "Ernie Stewart": USANAME2$ = "Cobi Jones"πUSAGOALIE$ = "Tony Meola"πSWITZERLANDNAME1$ = "Georges Bregy"πSWITZERLANDNAME2$ = "Adrian Knup"πSWITZERLANDGOALIE$ = "Marco Pasolo"πROMANIANAME1$ = "Ion Vladoiu"πROMANIANAME2$ = "Gheorghe Hagi"πROMANIAGOALIE$ = "Bogdan Stelea"πCOLOMBIANAME1$ = "Adolfo Valencia"πCOLOMBIANAME2$ = "Faustino Asprilla"πCOLOMBIAGOALIE$ = "Rene Higuita"πBRAZILNAME1$ = "Rai": BRAZILNAME2$ = "Romario"πBRAZILGOALIE$ = "Taffarel"πCAMEROONNAME1$ = "Stephen Tataw"πCAMEROONNAME2$ = "Raymond Kalla"πCAMEROONGOALIE$ = "Joseph-Antoine Bell"πSWEDENNAME1$ = "Martin 'Black Pearl' Dahlin"πSWEDENNAME2$ = "Tomas Brolin"πSWEDENGOALIE$ = "Thomas Ravelli"πRUSSIANAME1$ = "Victor Onopko"πRUSSIANAME2$ = "Sergei Yuran"πRUSSIAGOALIE$ = "Dmitri Kharine"πGERMANYNAME1$ = "Jurgen Klinsmann"πGERMANYNAME2$ = "Lothar Matthaus"πGERMANYGOALIE$ = "Bodo Illgner"πSPAINNAME1$ = "Juan Andoni Goicoechea"πSPAINNAME2$ = "Julio Salinas"πSPAINGOALIE$ = "Adoni Zubizarreta"πSOUTHKOREANAME1$ = "Jung-Won Seo"πSOUTHKOREANAME2$ = "Myung-Bo Hong"πSOUTHKOREAGOALIE$ = "In-Young Choi"πBOLIVIANAME1$ = "Luis Critaldo"πBOLIVIANAME2$ = "Julio Cesar Baldivieso"πBOLIVIAGOALIE$ = "Carlos Trucco"πARGENTINANAME1$ = "Diego Maradona"πARGENTINANAME2$ = "Gabriel Batistuta"πARGENTINAGOALIE$ = "Sergio Goycochea"πNIGERIANAME1$ = "Rashidi Yekini"πNIGERIANAME2$ = "Daniel Amokachi"πNIGERIAGOALIE$ = "Peter Rufai"πBULGARIANAME1$ = "Hristo Stoichkov"πBULGARIANAME2$ = "Yordan Lechkov"πBULGARIAGOALIE$ = "Antonis Minou"πGREECENAME1$ = "Anastassios Mitropoulos"πGREECENAME2$ = "Dimitris Saravakos"πGREECEGOALIE$ = "Borislav Mikhailov"πIRELANDNAME1$ = "Tommy Coyne"πIRELANDNAME2$ = "Paul McGrath"πIRELANDGOALIE$ = "Patrick Bonner"πNORWAYNAME1$ = "Henning Berg"πNORWAYNAME2$ = "Oyvind Leonhardsen"πNORWAYGOALIE$ = "Erik Thorstvedt"πITALYNAME1$ = "Roberto Baggio"πITALYNAME2$ = "Pierluigi Casiraghi"πITALYGOALIE$ = "Luca Marchegiani"πMEXICONAME1$ = "Alberto Garcia Aspe"πMEXICONAME2$ = "Luis Garcia"πMEXICOGOALIE$ = "Jorge Campos"πBELGIUMNAME1$ = "Marc Degryse"πBELGIUMNAME2$ = "Luc Nillis"πBELGIUMGOALIE$ = "Michel Prued'Homme"πNETHERLANDSNAME1$ = "Wim Jonk"πNETHERLANDSNAME2$ = "Gaston Taument"πNETHERLANDSGOALIE$ = "Ed de Goey"πSAUDIARABIANAME1$ = "Fuad Anwar Amin"πSAUDIARABIANAME2$ = "Majed Mohammed"πSAUDIARABIAGOALIE$ = "Mohammed Al-Deayea"πMOROCCONAME1$ = "Mohammed Lashaf"πMOROCCONAME2$ = "Mustapha El Hadaoui"πMOROCCOGOALIE$ = "Khalil Azmi"πSCREEN 9: DIM MINI%(1 TO 500)πPAINT (320, 175), 2πGET (100, 100)-(130, 115), MINI%πCLS : GOSUB INTROπ1 GOSUB MENUπππX = 450: Y = 100πGOSUB STRIKER: BALLX = 100: BALLY = 100πGOSUB SELECTION: GOSUB MAINGAMEπGOTO 1πENDπUSA: πSTEAL = 45: SPEED = 8: HANDS = 46πCLS : LOCATE 1, 38: PRINT "USA"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 4: NEXT TπFOR T = 27 TO 40: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 52 TO 65: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 77 TO 90: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 102 TO 115: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 127 TO 140: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 152 TO 165: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 15 TO 101: LINE (0, T)-(200, T), 1: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; USANAME1$πLOCATE 17, 25: PRINT "Player 2: "; USANAME2$πLOCATE 19, 27: PRINT "Goalie: "; USAGOALIE$πNAME1$ = USANAME1$: NAME2$ = USANAME2$πGOALIE$ = USAGOALIE$πRETURNπGREECE: πSTEAL = 15: SPEED = 2: HANDS = 22πCLS : LOCATE 1, 36: PRINT "Greece"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 9: NEXT TπFOR T = 27 TO 40: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 77 TO 90: LINE (200, T)-(640, T), 15: NEXT TπFOR T = 102 TO 115: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 127 TO 140: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 152 TO 165: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 15 TO 101: LINE (0, T)-(200, T), 9: NEXT TπFOR T = 52 TO 65: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 92 TO 108: LINE (T, 15)-(T, 102), 15: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; GREECENAME1$πLOCATE 17, 25: PRINT "Player 2: "; GREECENAME2$πLOCATE 19, 27: PRINT "Goalie: "; GREECEGOALIE$πNAME1$ = GREECENAME1$: NAME2$ = GREECENAME2$πGOALIE$ = GREECEGOALIE$πRETURNπCOLOMBIA: πSTEAL = 75: SPEED = 13: HANDS = 49πCLS : LOCATE 1, 35: PRINT "Colombia"πFOR T = 15 TO 88: LINE (0, T)-(640, T), 14: NEXT TπFOR T = 89 TO 122: LINE (0, T)-(640, T), 1: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; COLOMBIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; COLOMBIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; COLOMBIAGOALIE$πNAME1$ = COLOMBIANAME1$: NAME2$ = COLOMBIANAME2$πGOALIE$ = COLOMBIAGOALIE$πRETURNπRUSSIA: πSTEAL = 35: SPEED = 6: HANDS = 37πππCLS : LOCATE 1, 35: PRINT "Russia"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 1: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; RUSSIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; RUSSIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; RUSSIAGOALIE$πNAME1$ = RUSSIANAME1$: NAME2$ = RUSSIANAME2$πGOALIE$ = RUSSIAGOALIE$πRETURNπBOLIVIA: πSTEAL = 49: SPEED = 10: HANDS = 41πCLS : LOCATE 1, 36: PRINT "Bolivia"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 12: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 14: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 10: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; BOLIVIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; BOLIVIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; BOLIVIAGOALIE$πNAME1$ = BOLIVIANAME1$: NAME2$ = BOLIVIANAME2$πGOALIE$ = BOLIVIAGOALIE$πRETURNπGERMANY: πSTEAL = 93: SPEED = 17: HANDS = 70πCLS : LOCATE 1, 35: PRINT "Germany": FOR T = 15 TO 68πLINE (0, T)-(640, T), 0: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 4: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 14: NEXT TπLINE (0, 15)-(640, 15), 15: LINE (0, 15)-(0, 68), 15πLINE (639, 15)-(639, 68), 15πLOCATE 15, 25: PRINT "Player 1: "; GERMANYNAME1$πLOCATE 17, 25: PRINT "Player 2: "; GERMANYNAME2$πLOCATE 19, 27: PRINT "Goalie: "; GERMANYGOALIE$πNAME1$ = GERMANYNAME1$: NAME2$ = GERMANYNAME2$πGOALIE$ = GERMANYGOALIE$πRETURNπSPAIN: πSTEAL = 63: SPEED = 13: HANDS = 54πCLS : LOCATE 1, 35: PRINT "Spain"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 4: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 14: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; SPAINNAME1$πLOCATE 17, 25: PRINT "Player 2: "; SPAINNAME2$πLOCATE 19, 27: PRINT "Goalie: "; SPAINGOALIE$πNAME1$ = SPAINNAME1$: NAME2$ = SPAINNAME2$πGOALIE$ = SPAINGOALIE$πRETURNπARGENTINA: πSTEAL = 74: SPEED = 13: HANDS = 61πCLS : LOCATE 1, 36: PRINT "Argentina"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 9: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 9: NEXT TπππCIRCLE (320, 95), 20, 14: PAINT (320, 95), 14πLOCATE 15, 25: PRINT "Player 1: "; ARGENTINANAME1$πLOCATE 17, 25: PRINT "Player 2: "; ARGENTINANAME2$πLOCATE 19, 27: PRINT "Goalie: "; ARGENTINAGOALIE$πNAME1$ = ARGENTINANAME1$: NAME2$ = ARGENTINANAME2$πGOALIE$ = ARGENTINAGOALIE$πRETURNπBULGARIA: πSTEAL = 73: SPEED = 11: HANDS = 53πCLS : LOCATE 1, 35: PRINT "Bulgaria"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 10: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; BULGARIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; BULGARIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; BULGARIAGOALIE$πNAME1$ = BULGARIANAME1$: NAME2$ = BULGARIANAME2$πGOALIE$ = BULGARIAGOALIE$πRETURNπNETHERLANDS: πSTEAL = 86: SPEED = 17: HANDS = 68πCLS : LOCATE 1, 33: PRINT "Netherlands"πFOR T = 15 TO 68: LINE (0, T)-(640, T), 4: NEXT TπFOR T = 69 TO 122: LINE (0, T)-(640, T), 15: NEXT TπFOR T = 123 TO 175: LINE (0, T)-(640, T), 1: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; NETHERLANDSNAME1$πLOCATE 17, 25: PRINT "Player 2: "; NETHERLANDSNAME2$πLOCATE 19, 27: PRINT "Goalie: "; NETHERLANDSGOALIE$πNAME1$ = NETHERLANDSNAME1$: NAME2$ = NETHERLANDSNAME2$πGOALIE$ = NETHERLANDSGOALIE$πRETURNπSAUDIARABIA: πSTEAL = 18: SPEED = 4: HANDS = 23πCLS : LOCATE 1, 32: PRINT "Saudi Arabia"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 2: NEXT TπFOR H = 1 TO 50: LET R = INT(RND(1) * 400) + 120πLET S = INT(RND(1) * 30) + 65πLET R2 = INT(RND(1) * 400) + 120πLET S2 = INT(RND(1) * 30) + 95πLINE (R, S)-(R2, S2), 15: NEXT HπFOR T = 0 TO 7πLINE (140 + (8 * T), 135 + T)-(490, 135 + T): NEXT TπCIRCLE (490, 141), 8, 15: PAINT (492, 143), 15, 15πFOR T = 420 TO 425: LINE (T, 125)-(T, 152), 15: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; SAUDIARABIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; SAUDIARABIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; SAUDIARABIAGOALIE$πNAME1$ = SAUDIARABIANAME1$: NAME2$ = SAUDIARABIANAME2$πGOALIE$ = SAUDIARABIAGOALIE$πRETURNπROMANIA: πSTEAL = 32: SPEED = 8: HANDS = 42πCLS : LOCATE 1, 35: PRINT "Romania"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 1: NEXT TπππFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 14: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; ROMANIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; ROMANIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; ROMANIAGOALIE$πNAME1$ = ROMANIANAME1$: NAME2$ = ROMANIANAME2$πGOALIE$ = ROMANIAGOALIE$πRETURNπCAMEROON: πSTEAL = 50: SPEED = 10: HANDS = 46πCLS : LOCATE 1, 36: PRINT "Cameroon"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 10: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 12: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 14: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; CAMEROONNAME1$πLOCATE 17, 25: PRINT "Player 2: "; CAMEROONNAME2$πLOCATE 19, 27: PRINT "Goalie: "; CAMEROONGOALIE$πNAME1$ = CAMEROONNAME1$: NAME2$ = CAMEROONNAME2$πGOALIE$ = CAMEROONGOALIE$πRETURNπNIGERIA: πSTEAL = 43: SPEED = 7: HANDS = 38πCLS : LOCATE 1, 36: PRINT "Nigeria"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 2: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 15: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 2: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; NIGERIANAME1$πLOCATE 17, 25: PRINT "Player 2: "; NIGERIANAME2$πLOCATE 19, 27: PRINT "Goalie: "; NIGERIAGOALIE$πNAME1$ = NIGERIANAME1$: NAME2$ = NIGERIANAME2$πGOALIE$ = NIGERIAGOALIE$πRETURNπIRELAND: πSTEAL = 69: SPEED = 15: HANDS = 58πCLS : LOCATE 1, 35: PRINT "Ireland"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 2: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 15: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 12: NEXT TπFOR T = 428 TO 640 STEP 2: LINE (T, 15)-(T, 175), 14πNEXT TπLOCATE 15, 25: PRINT "Player 1: "; IRELANDNAME1$πLOCATE 17, 25: PRINT "Player 2: "; IRELANDNAME2$πLOCATE 19, 27: PRINT "Goalie: "; IRELANDGOALIE$πNAME1$ = IRELANDNAME1$: NAME2$ = IRELANDNAME2$πGOALIE$ = IRELANDGOALIE$πRETURNπITALY: πSTEAL = 92: SPEED = 20: HANDS = 70πCLS : LOCATE 1, 36: PRINT "Italy"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 2: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 15: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; ITALYNAME1$πLOCATE 17, 25: PRINT "Player 2: "; ITALYNAME2$πππLOCATE 19, 27: PRINT "Goalie: "; ITALYGOALIE$πNAME1$ = ITALYNAME1$: NAME2$ = ITALYNAME2$πGOALIE$ = ITALYGOALIE$πRETURNπMEXICO: πSTEAL = 53: SPEED = 13: HANDS = 56πCLS : LOCATE 1, 36: PRINT "Mexico"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 2: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 15: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 4: NEXT TπCIRCLE (320, 95), 20, 6: PAINT (320, 95), 6πLOCATE 15, 25: PRINT "Player 1: "; MEXICONAME1$πLOCATE 17, 25: PRINT "Player 2: "; MEXICONAME2$πLOCATE 19, 27: PRINT "Goalie: "; MEXICOGOALIE$πNAME1$ = MEXICONAME1$: NAME2$ = MEXICONAME2$πGOALIE$ = MEXICOGOALIE$πRETURNπBELGIUM: πSTEAL = 57: SPEED = 14: HANDS = 55πCLS : LOCATE 1, 35: PRINT "Belgium"πFOR T = 1 TO 213: LINE (T, 15)-(T, 175), 0: NEXT TπFOR T = 214 TO 427: LINE (T, 15)-(T, 175), 14: NEXT TπFOR T = 428 TO 640: LINE (T, 15)-(T, 175), 4: NEXT TπLINE (0, 15)-(213, 15), 15: LINE (0, 15)-(0, 175), 15πLINE (0, 175)-(213, 175), 15πLOCATE 15, 25: PRINT "Player 1: "; BELGIUMNAME1$πLOCATE 17, 25: PRINT "Player 2: "; BELGIUMNAME2$πLOCATE 19, 27: PRINT "Goalie: "; BELGIUMGOALIE$πNAME1$ = BELGIUMNAME1$: NAME2$ = BELGIUMNAME2$πGOALIE$ = BELGIUMGOALIE$πRETURNπBRAZIL: πSTEAL = 99: SPEED = 20: HANDS = 75πCLS : LOCATE 1, 37: PRINT "Brazil"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 2: NEXT TπLINE (320, 35)-(600, 95), 14πLINE (600, 95)-(320, 155), 14πLINE (320, 155)-(40, 95), 14πLINE (40, 95)-(320, 35), 14: PAINT (320, 95), 14πCIRCLE (320, 95), 70, 9: PAINT (320, 95), 9πLOCATE 15, 25: PRINT "Player 1: "; BRAZILNAME1$πLOCATE 17, 25: PRINT "Player 2: "; BRAZILNAME2$πLOCATE 19, 27: PRINT "Goalie: "; BRAZILGOALIE$πNAME1$ = BRAZILNAME1$: NAME2$ = BRAZILNAME2$πGOALIE$ = BRAZILGOALIE$πRETURNπMOROCCO: πSTEAL = 20: SPEED = 3: HANDS = 26πCLS : LOCATE 1, 34: PRINT "Morocco"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; MOROCCONAME1$πLOCATE 17, 25: PRINT "Player 2: "; MOROCCONAME2$πLOCATE 19, 27: PRINT "Goalie: "; MOROCCOGOALIE$πNAME1$ = MOROCCONAME1$: NAME2$ = MOROCCONAME2$πππGOALIE$ = MOROCCOGOALIE$πRETURNπSOUTHKOREA: πSTEAL = 18: SPEED = 4: HANDS = 27πCLS : LOCATE 1, 34: PRINT "South Korea"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 15: NEXT TπCIRCLE (320, 95), 60, 0: CIRCLE (290, 95), 30, 4πCIRCLE (350, 95), 30, 1: PAINT (350, 95), 1πCIRCLE (290, 95), 30, 4: PAINT (290, 95), 4πCIRCLE (290, 95), 30, 0: CIRCLE (350, 95), 30, 0πPAINT (320, 65), 4, 0: PAINT (350, 125), 1, 0πCIRCLE (290, 95), 30, 4: CIRCLE (350, 95), 30, 1πLOCATE 15, 25: PRINT "Player 1: "; SOUTHKOREANAME1$πLOCATE 17, 25: PRINT "Player 2: "; SOUTHKOREANAME2$πLOCATE 19, 27: PRINT "Goalie: "; SOUTHKOREAGOALIE$πNAME1$ = SOUTHKOREANAME1$: NAME2$ = SOUTHKOREANAME2$πGOALIE$ = SOUTHKOREAGOALIE$πRETURNπSWEDEN: πSTEAL = 68: SPEED = 13: HANDS = 59πCLS : LOCATE 1, 36: PRINT "Sweden"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 9: NEXT TπFOR T = 90 TO 110: LINE (T, 15)-(T, 175), 14: NEXT TπFOR T = 85 TO 105: LINE (0, T)-(640, T), 14: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; SWEDENNAME1$πLOCATE 17, 25: PRINT "Player 2: "; SWEDENNAME2$πLOCATE 19, 27: PRINT "Goalie: "; SWEDENGOALIE$πNAME1$ = SWEDENNAME1$: NAME2$ = SWEDENNAME2$πGOALIE$ = SWEDENGOALIE$πRETURNπNORWAY: πSTEAL = 74: SPEED = 11: HANDS = 53πCLS : LOCATE 1, 35: PRINT "Norway"πFOR T = 15 TO 175: LINE (0, T)-(640, T), 4: NEXT TπLINE (0, 84)-(640, 84), 15: LINE (0, 106)-(640, 106), 15πLINE (209, 15)-(209, 175), 15πLINE (231, 15)-(231, 175), 15πFOR T = 210 TO 230: LINE (T, 15)-(T, 175), 1: NEXT TπFOR T = 85 TO 105: LINE (0, T)-(640, T), 1: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; NORWAYNAME1$πLOCATE 17, 25: PRINT "Player 2: "; NORWAYNAME2$πLOCATE 19, 27: PRINT "Goalie: "; NORWAYGOALIE$πNAME1$ = NORWAYNAME1$: NAME2$ = NORWAYNAME2$πGOALIE$ = NORWAYGOALIE$πRETURNπSWITZERLAND: πSTEAL = 62: SPEED = 14: HANDS = 59πCLS : LOCATE 1, 34: PRINT "Switzerland"πFOR T = 190 TO 450: LINE (T, 15)-(T, 175), 4: NEXT TπFOR T = 300 TO 340: LINE (T, 35)-(T, 155), 15: NEXT TπFOR T = 80 TO 110: LINE (210, T)-(430, T), 15: NEXT TπLOCATE 15, 25: PRINT "Player 1: "; SWITZERLANDNAME1$πLOCATE 17, 25: PRINT "Player 2: "; SWITZERLANDNAME2$πLOCATE 19, 27: PRINT "Goalie: "; SWITZERLANDGOALIE$πππNAME1$ = SWITZERLANDNAME1$: NAME2$ = SWITZERLANDNAME2$πGOALIE$ = SWITZERLANDGOALIE$πRETURNπFLASHER: πCLS : LET KO = INT(RND(1) * 15) + 1πPAINT (320, 175), KOπRETURNπINTRO: πINTROER = 1: CLS : SCREEN 9, , 0, 0: PCOPY 0, 1πBALLY = -220: FOR BALLX = -700 TO 800 STEP 50πSCREEN 9, , 0, 1: GOSUB SOCCERFIELDπLOCATE 12, 32: PRINT "By Alex Makris": SCREEN 9, , 0, 0πPCOPY 0, 1: NEXT BALLXπFOR BALLY = -220 TO -20 STEP 12.5: SCREEN 9, , 0, 1πGOSUB SOCCERFIELD: LOCATE 12, 32: PRINT "By Alex Makris"πSCREEN 9, , 0, 0: PCOPY 0, 1: NEXT BALLYπFOR BALLX = 800 TO -700 STEP -50: SCREEN 9, , 0, 1πGOSUB SOCCERFIELD: SCREEN 9, , 0, 0: PCOPY 0, 1πFOR T = 1 TO 200: NEXT T: NEXT BALLXπFOR BALLY = -20 TO 180 STEP 12.5: SCREEN 9, , 0, 1πGOSUB SOCCERFIELD: SCREEN 9, , 0, 0: PCOPY 0, 1πNEXT BALLY: FOR BALLX = -700 TO 800 STEP 50πSCREEN 9, , 0, 1: GOSUB SOCCERFIELDπLOCATE 12, 30: PRINT "World Cup Soccer 94"πSCREEN 9, , 0, 0: PCOPY 0, 1: NEXT BALLXπFOR BALLY = 180 TO 380 STEP 12.5: SCREEN 9, , 0, 1πGOSUB SOCCERFIELDπLOCATE 12, 30: PRINT "World Cup Soccer 94"πSCREEN 9, , 0, 0: PCOPY 0, 1: NEXT BALLYπFOR BALLX = 800 TO -900 STEP -50: SCREEN 9, , 0, 1πGOSUB SOCCERFIELD: SCREEN 9, , 0, 0: PCOPY 0, 1πNEXT BALLX: INTROER = 0πRETURNπLOGO: πLINE (X, Y)-(X + 40, Y), 0πLINE (X + 40, Y)-(X + 40, Y + 30), 0πLINE (X + 40, Y + 30)-(X + 20, Y + 30), 0πLINE (X + 20, Y + 30)-(X + 20, Y + 70), 0πLINE (X + 20, Y + 70)-(X + 40, Y + 70), 0πLINE (X + 40, Y + 70)-(X + 40, Y + 150), 0πLINE (X + 40, Y + 150)-(X, Y + 180), 0πLINE (X, Y + 180)-(X, Y + 140), 0πLINE (X, Y + 140)-(X + 20, Y + 130), 0πLINE (X + 20, Y + 130)-(X + 20, Y + 100), 0πLINE (X + 20, Y + 100)-(X, Y + 100), 0πLINE (X, Y + 100)-(X, Y), 0πLINE (X + 50, Y)-(X + 95, Y), 0πLINE (X + 95, Y)-(X + 95, Y + 110), 0πLINE (X + 95, Y + 110)-(X + 50, Y + 140), 0πLINE (X + 50, Y + 140)-(X + 50, Y), 0πLINE (X + 65, Y + 20)-(X + 80, Y + 20), 0πLINE (X + 80, Y + 20)-(X + 80, Y + 105), 0πLINE (X + 80, Y + 105)-(X + 65, Y + 114), 0πLINE (X + 65, Y + 114)-(X + 65, Y + 20), 0πππLINE (X + 105, Y)-(X + 135, Y), 0πLINE (X + 135, Y)-(X + 135, Y + 20), 0πLINE (X + 135, Y + 20)-(X + 120, Y + 20), 0πLINE (X + 120, Y + 20)-(X + 120, Y + 85), 0πLINE (X + 120, Y + 85)-(X + 135, Y + 75), 0πLINE (X + 135, Y + 75)-(X + 135, Y + 92), 0πLINE (X + 135, Y + 92)-(X + 105, Y + 107), 0πLINE (X + 105, Y + 107)-(X + 105, Y), 0πLINE (X + 145, Y)-(X + 180, Y), 0πLINE (X + 180, Y)-(X + 180, Y + 20), 0πLINE (X + 180, Y + 20)-(X + 160, Y + 20), 0πLINE (X + 160, Y + 20)-(X + 160, Y + 75), 0πLINE (X + 160, Y + 75)-(X + 180, Y + 65), 0πLINE (X + 180, Y + 65)-(X + 180, Y + 80), 0πLINE (X + 180, Y + 80)-(X + 145, Y + 90), 0πLINE (X + 145, Y + 90)-(X + 145, Y), 0πLINE (X + 190, Y)-(X + 220, Y), 0πLINE (X + 220, Y)-(X + 220, Y + 20), 0πLINE (X + 220, Y + 20)-(X + 205, Y + 20), 0πLINE (X + 205, Y + 20)-(X + 205, Y + 30), 0πLINE (X + 205, Y + 30)-(X + 220, Y + 30), 0πLINE (X + 220, Y + 30)-(X + 220, Y + 40), 0πLINE (X + 220, Y + 40)-(X + 205, Y + 40), 0πLINE (X + 205, Y + 40)-(X + 205, Y + 65), 0πLINE (X + 205, Y + 65)-(X + 220, Y + 60), 0πLINE (X + 220, Y + 60)-(X + 220, Y + 70), 0πLINE (X + 220, Y + 70)-(X + 190, Y + 78), 0πLINE (X + 190, Y + 78)-(X + 190, Y), 0πLINE (X + 230, Y)-(X + 270, Y), 0πLINE (X + 270, Y)-(X + 270, Y + 40), 0πLINE (X + 270, Y + 40)-(X + 265, Y + 43), 0πLINE (X + 265, Y + 43)-(X + 270, Y + 65), 0πLINE (X + 270, Y + 65)-(X + 255, Y + 66), 0πLINE (X + 255, Y + 66)-(X + 250, Y + 40), 0πLINE (X + 250, Y + 40)-(X + 245, Y + 40), 0πLINE (X + 245, Y + 40)-(X + 244, Y + 66), 0πLINE (X + 244, Y + 66)-(X + 230, Y + 68), 0πLINE (X + 230, Y + 68)-(X + 230, Y), 0πLINE (X + 245, Y + 15)-(X + 255, Y + 15), 0πLINE (X + 255, Y + 15)-(X + 255, Y + 31), 0πLINE (X + 255, Y + 31)-(X + 245, Y + 32), 0πLINE (X + 245, Y + 32)-(X + 245, Y + 15), 0πRETURNπLOGOCOVER: πLINE (X, Y)-(X + 40, Y), COVERπLINE (X + 40, Y)-(X + 40, Y + 30), COVERπLINE (X + 40, Y + 30)-(X + 20, Y + 30), COVERπLINE (X + 20, Y + 30)-(X + 20, Y + 70), COVERπLINE (X + 20, Y + 70)-(X + 40, Y + 70), COVERπLINE (X + 40, Y + 70)-(X + 40, Y + 150), COVERπLINE (X + 40, Y + 150)-(X, Y + 180), COVERπLINE (X, Y + 180)-(X, Y + 140), COVERπLINE (X, Y + 140)-(X + 20, Y + 130), COVERπLINE (X + 20, Y + 130)-(X + 20, Y + 100), COVERπππLINE (X + 20, Y + 100)-(X, Y + 100), COVERπLINE (X, Y + 100)-(X, Y), COVERπLINE (X + 50, Y)-(X + 95, Y), COVERπLINE (X + 95, Y)-(X + 95, Y + 110), COVERπLINE (X + 95, Y + 110)-(X + 50, Y + 140), COVERπLINE (X + 50, Y + 140)-(X + 50, Y), COVERπLINE (X + 65, Y + 20)-(X + 80, Y + 20), COVERπLINE (X + 80, Y + 20)-(X + 80, Y + 105), COVERπLINE (X + 80, Y + 105)-(X + 65, Y + 114), COVERπLINE (X + 65, Y + 114)-(X + 65, Y + 20), COVERπLINE (X + 105, Y)-(X + 135, Y), COVERπLINE (X + 135, Y)-(X + 135, Y + 20), COVERπLINE (X + 135, Y + 20)-(X + 120, Y + 20), COVERπLINE (X + 120, Y + 20)-(X + 120, Y + 85), COVERπLINE (X + 120, Y + 85)-(X + 135, Y + 75), COVERπLINE (X + 135, Y + 75)-(X + 135, Y + 92), COVERπLINE (X + 135, Y + 92)-(X + 105, Y + 107), COVERπLINE (X + 105, Y + 107)-(X + 105, Y), COVERπLINE (X + 145, Y)-(X + 180, Y), COVERπLINE (X + 180, Y)-(X + 180, Y + 20), COVERπLINE (X + 180, Y + 20)-(X + 160, Y + 20), COVERπLINE (X + 160, Y + 20)-(X + 160, Y + 75), COVERπLINE (X + 160, Y + 75)-(X + 180, Y + 65), COVERπLINE (X + 180, Y + 65)-(X + 180, Y + 80), COVERπLINE (X + 180, Y + 80)-(X + 145, Y + 90), COVERπLINE (X + 145, Y + 90)-(X + 145, Y), COVERπLINE (X + 190, Y)-(X + 220, Y), COVERπLINE (X + 220, Y)-(X + 220, Y + 20), COVERπLINE (X + 220, Y + 20)-(X + 205, Y + 20), COVERπLINE (X + 205, Y + 20)-(X + 205, Y + 30), COVERπLINE (X + 205, Y + 30)-(X + 220, Y + 30), COVERπLINE (X + 220, Y + 30)-(X + 220, Y + 40), COVERπLINE (X + 220, Y + 40)-(X + 205, Y + 40), COVERπLINE (X + 205, Y + 40)-(X + 205, Y + 65), COVERπLINE (X + 205, Y + 65)-(X + 220, Y + 60), COVERπLINE (X + 220, Y + 60)-(X + 220, Y + 70), COVERπLINE (X + 220, Y + 70)-(X + 190, Y + 78), COVERπLINE (X + 190, Y + 78)-(X + 190, Y), COVERπLINE (X + 230, Y)-(X + 270, Y), COVERπLINE (X + 270, Y)-(X + 270, Y + 40), COVERπLINE (X + 270, Y + 40)-(X + 265, Y + 43), COVERπLINE (X + 265, Y + 43)-(X + 270, Y + 65), COVERπLINE (X + 270, Y + 65)-(X + 255, Y + 66), COVERπLINE (X + 255, Y + 66)-(X + 250, Y + 40), COVERπLINE (X + 250, Y + 40)-(X + 245, Y + 40), COVERπLINE (X + 245, Y + 40)-(X + 244, Y + 66), COVERπLINE (X + 244, Y + 66)-(X + 230, Y + 68), COVERπLINE (X + 230, Y + 68)-(X + 230, Y), COVERπLINE (X + 245, Y + 15)-(X + 255, Y + 15), COVERπLINE (X + 255, Y + 15)-(X + 255, Y + 31), COVERπLINE (X + 255, Y + 31)-(X + 245, Y + 32), COVERπLINE (X + 245, Y + 32)-(X + 245, Y + 15), COVERπRETURNπMENU: πππ10000 CLS : PAINT (320, 175), 2: Y = 42πFOR X = -250 TO 190 STEP 20: GOSUB LOGOπGOSUB LOGOFLASH: COVER = 2πSCREEN 9, , 0, 0: PCOPY 0, 1πIF X <> 190 THEN GOSUB LOGOCOVER: GOSUB LOGOLETTERCOVERπPLAY "O2 L64 G": NEXT X: PLAY "O0 L10 C"πFOR T = 1 TO 10000: NEXT T: PLAY "O4 L64 CBAGFED"πLOCATE 4, 22: PRINT "W": LOCATE 5, 22: PRINT "o"πLOCATE 6, 22: PRINT "r": LOCATE 7, 22: PRINT "l"πLOCATE 8, 22: PRINT "d": LOCATE 10, 22πPRINT "C": LOCATE 11, 22: PRINT "u": LOCATE 12, 22πPRINT "p": LOCATE 14, 22: PRINT "9": LOCATE 15, 22πPRINT "4": FOR T = 1 TO 10000: NEXT TπFOR T = 3000 TO 100 STEP -1000: SOUND T, 1: NEXT TπLOCATE 16, 35: PRINT "Main Menu"πLOCATE 18, 26: PRINT "1) Instructions "πLOCATE 19, 26: PRINT "2) Print operation controls"πLOCATE 20, 26: PRINT "3) Start playing "πLOCATE 21, 26: PRINT "4) Quit "πX = 450: Y = 100: GOSUB STRIKERπPRINT "Enter choice:"πA$ = " "π10001 A$ = INKEY$πIF A$ <> "1" AND A$ <> "2" AND A$ <> "3" AND A$ <> "4" THEN GOTO 10001πIF A$ = "1" THEN GOSUB INSTRUCTIONS: GOTO 10000πIF A$ = "2" THEN GOSUB CONTROLS: GOTO 10000πIF A$ = "4" THEN ENDπIF A$ <> "3" THEN GOTO 10000πRETURNπLOGOFLASH: πLET H = INT(RND(1) * 14) + 1: IF X = 190 THEN H = 14πPAINT (X + 10, Y + 3), H, 0: PAINT (X + 60, Y + 3), H, 0πPAINT (X + 110, Y + 3), H, 0: PAINT (X + 155, Y + 3), H, 0πPAINT (X + 200, Y + 3), H, 0: PAINT (X + 240, Y + 3), H, 0πRETURNπLOGOLETTERCOVER: πPAINT (X + 10, Y + 3), COVER, 0πPAINT (X + 60, Y + 3), COVER, 0πPAINT (X + 110, Y + 3), COVER, 0πPAINT (X + 155, Y + 3), COVER, 0πPAINT (X + 200, Y + 3), COVER, 0πPAINT (X + 240, Y + 3), COVER, 0πRETURNπSTRIKER: πLINE (X + 27, Y + 41)-(X + 35, Y + 49), 0πLINE (X + 35, Y + 49)-(X + 29, Y + 48), 0πLINE (X + 29, Y + 48)-(X + 25, Y + 50), 0πLINE (X + 25, Y + 50)-(X + 27, Y + 41), 0πPAINT (X + 29, Y + 46), 0, 0πLINE (X, Y + 100)-(X + 5, Y + 95), 0πLINE (X + 5, Y + 95)-(X + 20, Y + 90), 0πLINE (X + 20, Y + 90)-(X + 30, Y + 100), 0πLINE (X + 30, Y + 100)-(X + 25, Y + 110), 0πLINE (X + 25, Y + 110)-(X + 20, Y + 115), 0πππLINE (X + 20, Y + 115)-(X + 10, Y + 110), 0πLINE (X + 10, Y + 110)-(X, Y + 100), 0πPAINT (X + 15, Y + 100), 0, 0πLINE (X + 25, Y + 61)-(X + 31, Y + 54), 0πLINE (X + 31, Y + 54)-(X + 36, Y + 58), 0πLINE (X + 36, Y + 58)-(X + 37, Y + 64), 0πLINE (X + 37, Y + 64)-(X + 35, Y + 70), 0πLINE (X + 35, Y + 70)-(X + 28, Y + 69), 0πLINE (X + 28, Y + 69)-(X + 25, Y + 61), 0πPAINT (X + 32, Y + 62), 15, 0πLINE (X + 25, Y + 61)-(X + 32, Y + 60), 0πLINE (X + 32, Y + 60)-(X + 35, Y + 70), 0πPAINT (X + 30, Y + 63), 0, 0πLINE (X + 5, Y + 95)-(X + 20, Y + 65), 0πLINE (X + 20, Y + 65)-(X + 30, Y + 50), 0πLINE (X + 30, Y + 50)-(X + 38, Y + 45), 0πLINE (X + 38, Y + 45)-(X + 47, Y + 55), 0πLINE (X + 47, Y + 55)-(X + 52, Y + 70), 0πLINE (X + 52, Y + 70)-(X + 50, Y + 80), 0πLINE (X + 50, Y + 80)-(X + 45, Y + 90), 0πLINE (X + 45, Y + 90)-(X + 45, Y + 100), 0πLINE (X + 45, Y + 100)-(X + 40, Y + 112), 0πLINE (X + 40, Y + 112)-(X + 30, Y + 118), 0πLINE (X + 30, Y + 118)-(X + 20, Y + 115), 0πPAINT (X + 30, Y + 80), 6, 0πLINE (X + 45, Y + 90)-(X + 38, Y + 79), 0πLINE (X + 38, Y + 79)-(X + 43, Y + 80), 0πLINE (X + 38, Y + 79)-(X + 34, Y + 81), 0πLINE (X + 25, Y + 20)-(X + 32, Y + 6), 0πLINE (X + 32, Y + 6)-(X + 37, Y + 7), 0πLINE (X + 37, Y + 7)-(X + 32, Y + 20), 0πLINE (X + 32, Y + 20)-(X + 33, Y + 38), 0πLINE (X + 33, Y + 38)-(X + 26, Y + 31), 0πLINE (X + 26, Y + 31)-(X + 25, Y + 20), 0πPAINT (X + 29, Y + 20), 0, 0πLINE (X + 41, Y + 44)-(X + 55, Y + 29), 0πLINE (X + 55, Y + 29)-(X + 65, Y + 31), 0πLINE (X + 65, Y + 31)-(X + 74, Y + 44), 0πLINE (X + 74, Y + 44)-(X + 55, Y + 40), 0πLINE (X + 55, Y + 40)-(X + 41, Y + 44), 0πPAINT (X + 57, Y + 33), 0, 0πLINE (X + 50, Y + 80)-(X + 60, Y + 90), 0πLINE (X + 60, Y + 90)-(X + 59, Y + 95), 0πLINE (X + 59, Y + 95)-(X + 60, Y + 100), 0πLINE (X + 60, Y + 100)-(X + 45, Y + 90), 0πPAINT (X + 55, Y + 90), 6, 0πLINE (X + 60, Y + 90)-(X + 79, Y + 82), 0πLINE (X + 79, Y + 82)-(X + 81, Y + 89), 0πLINE (X + 81, Y + 89)-(X + 76, Y + 90), 0πLINE (X + 76, Y + 90)-(X + 72, Y + 90), 0πLINE (X + 72, Y + 90)-(X + 71, Y + 100), 0πLINE (X + 71, Y + 100)-(X + 75, Y + 105), 0πLINE (X + 75, Y + 105)-(X + 77, Y + 100), 0πLINE (X + 77, Y + 100)-(X + 80, Y + 106), 0πππLINE (X + 80, Y + 106)-(X + 75, Y + 110), 0πLINE (X + 75, Y + 110)-(X + 65, Y + 105), 0πLINE (X + 65, Y + 105)-(X + 66, Y + 96), 0πLINE (X + 66, Y + 96)-(X + 64, Y + 97), 0πLINE (X + 64, Y + 97)-(X + 62, Y + 106), 0πLINE (X + 62, Y + 106)-(X + 60, Y + 107), 0πLINE (X + 60, Y + 107)-(X + 60, Y + 100), 0πPAINT (X + 67, Y + 97), 4, 0πLINE (X + 60, Y + 107)-(X + 61, Y + 120), 0πLINE (X + 61, Y + 120)-(X + 70, Y + 130), 0πLINE (X + 70, Y + 130)-(X + 75, Y + 129), 0πLINE (X + 75, Y + 129)-(X + 80, Y + 120), 0πLINE (X + 80, Y + 120)-(X + 83, Y + 113), 0πLINE (X + 83, Y + 113)-(X + 80, Y + 106), 0πPAINT (X + 70, Y + 115), 15, 0πLINE (X + 83, Y + 113)-(X + 87, Y + 119), 0πLINE (X + 87, Y + 119)-(X + 85, Y + 122), 0πLINE (X + 85, Y + 122)-(X + 90, Y + 125), 0πLINE (X + 90, Y + 125)-(X + 99, Y + 121), 0πLINE (X + 99, Y + 121)-(X + 101, Y + 141), 0πLINE (X + 101, Y + 141)-(X + 92, Y + 151), 0πLINE (X + 92, Y + 151)-(X + 71, Y + 148), 0πLINE (X + 71, Y + 148)-(X + 46, Y + 152), 0πLINE (X + 46, Y + 152)-(X + 50, Y + 139), 0πLINE (X + 50, Y + 139)-(X + 48, Y + 130), 0πLINE (X + 48, Y + 130)-(X + 40, Y + 121), 0πLINE (X + 40, Y + 121)-(X + 51, Y + 122), 0πLINE (X + 51, Y + 122)-(X + 61, Y + 120), 0πPAINT (X + 70, Y + 137), 1, 0πLINE (X + 48, Y + 130)-(X + 36, Y + 138), 0πLINE (X + 36, Y + 138)-(X + 37, Y + 126), 0πLINE (X + 37, Y + 126)-(X + 40, Y + 121), 0πPAINT (X + 42, Y + 130), 0, 0πLINE (X + 36, Y + 138)-(X + 30, Y + 141), 0πLINE (X + 30, Y + 141)-(X + 35, Y + 150), 0πLINE (X + 35, Y + 150)-(X + 47, Y + 147), 0πPAINT (X + 40, Y + 140), 6, 0πLINE (X + 35, Y + 150)-(X + 30, Y + 152), 0πLINE (X + 30, Y + 152)-(X + 25, Y + 144), 0πLINE (X + 25, Y + 144)-(X + 30, Y + 141), 0πPAINT (X + 31, Y + 146), 15, 0πLINE (X + 30, Y + 152)-(X + 25, Y + 154), 0πLINE (X + 25, Y + 154)-(X + 20, Y + 145), 0πLINE (X + 20, Y + 145)-(X + 25, Y + 144), 0πPAINT (X + 22, Y + 145), 4, 0πLINE (X + 25, Y + 154)-(X + 20, Y + 155), 0πLINE (X + 20, Y + 155)-(X + 15, Y + 147), 0πLINE (X + 15, Y + 147)-(X + 20, Y + 145), 0πPAINT (X + 16, Y + 147), 15, 0πLINE (X + 20, Y + 155)-(X + 16, Y + 162), 0πLINE (X + 16, Y + 162)-(X + 7, Y + 164), 0πLINE (X + 7, Y + 164)-(X + 4, Y + 150), 0πLINE (X + 4, Y + 150)-(X + 4, Y + 140), 0πLINE (X + 4, Y + 140)-(X + 14, Y + 126), 0πππLINE (X + 14, Y + 126)-(X + 27, Y + 130), 0πLINE (X + 27, Y + 130)-(X + 27, Y + 135), 0πLINE (X + 27, Y + 135)-(X + 15, Y + 147), 0πPAINT (X + 10, Y + 150), 0, 0πLINE (X + 101, Y + 141)-(X + 108, Y + 160), 0πLINE (X + 108, Y + 160)-(X + 104, Y + 164), 0πLINE (X + 104, Y + 164)-(X + 90, Y + 160), 0πLINE (X + 90, Y + 160)-(X + 85, Y + 153), 0πLINE (X + 85, Y + 153)-(X + 92, Y + 154), 0πLINE (X + 92, Y + 154)-(X + 92, Y + 151), 0πPAINT (X + 100, Y + 155), 6, 0πLINE (X + 85, Y + 153)-(X + 79, Y + 154), 0πLINE (X + 79, Y + 154)-(X + 90, Y + 160), 0πPAINT (X + 85, Y + 155), 15, 0πLINE (X + 90, Y + 160)-(X + 95, Y + 169), 0πLINE (X + 95, Y + 169)-(X + 99, Y + 180), 0πLINE (X + 99, Y + 180)-(X + 96, Y + 190), 0πLINE (X + 96, Y + 190)-(X + 85, Y + 190), 0πLINE (X + 85, Y + 190)-(X + 79, Y + 179), 0πLINE (X + 79, Y + 179)-(X + 72, Y + 160), 0πLINE (X + 72, Y + 160)-(X + 76, Y + 151), 0πLINE (X + 76, Y + 151)-(X + 80, Y + 155), 0πPAINT (X + 85, Y + 170), 0, 0πLINE (X + 72, Y + 90)-(X + 90, Y + 88), 0πLINE (X + 90, Y + 88)-(X + 85, Y + 75), 0πLINE (X + 85, Y + 75)-(X + 90, Y + 71), 0πLINE (X + 90, Y + 71)-(X + 92, Y + 72), 0πLINE (X + 92, Y + 72)-(X + 96, Y + 65), 0πLINE (X + 96, Y + 65)-(X + 100, Y + 61), 0πLINE (X + 100, Y + 61)-(X + 106, Y + 69), 0πLINE (X + 106, Y + 69)-(X + 115, Y + 75), 0πLINE (X + 115, Y + 75)-(X + 113, Y + 83), 0πLINE (X + 113, Y + 83)-(X + 108, Y + 86), 0πLINE (X + 108, Y + 86)-(X + 106, Y + 93), 0πLINE (X + 106, Y + 93)-(X + 101, Y + 92), 0πLINE (X + 101, Y + 92)-(X + 99, Y + 96), 0πLINE (X + 99, Y + 96)-(X + 95, Y + 96), 0πLINE (X + 95, Y + 96)-(X + 92, Y + 92), 0πLINE (X + 92, Y + 92)-(X + 77, Y + 100), 0πPAINT (X + 100, Y + 80), 6, 0πLINE (X + 92, Y + 72)-(X + 97, Y + 78), 0πLINE (X + 97, Y + 78)-(X + 95, Y + 81), 0πLINE (X + 95, Y + 81)-(X + 90, Y + 79), 0πLINE (X + 105, Y + 70)-(X + 97, Y + 75), 0πLINE (X + 107, Y + 85)-(X + 101, Y + 84), 0πLINE (X + 101, Y + 84)-(X + 98, Y + 80), 0πLINE (X + 101, Y + 84)-(X + 97, Y + 86), 0πLINE (X + 97, Y + 86)-(X + 97, Y + 91), 0πLINE (X + 97, Y + 91)-(X + 100, Y + 92), 0πLINE (X + 68, Y + 87)-(X + 62, Y + 73), 0πLINE (X + 62, Y + 73)-(X + 67, Y + 71), 0πLINE (X + 67, Y + 71)-(X + 67, Y + 67), 0πLINE (X + 67, Y + 67)-(X + 61, Y + 60), 0πLINE (X + 61, Y + 60)-(X + 58, Y + 55), 0πππLINE (X + 58, Y + 55)-(X + 55, Y + 58), 0πLINE (X + 55, Y + 58)-(X + 56, Y + 61), 0πLINE (X + 56, Y + 61)-(X + 52, Y + 62), 0πLINE (X + 52, Y + 62)-(X + 58, Y + 71), 0πLINE (X + 58, Y + 71)-(X + 57, Y + 86), 0πPAINT (X + 62, Y + 80), 6, 0πRETURNπSOCCERFIELD: πCLSπIF INTROER = 0 THENπ CIRCLE (320, 175), 5, 15: PAINT (320, 175), 15, 15πEND IFπFOR U = -20 TO 580 STEP 200πLINE (-200 - BALLX, U - BALLY)-(1000 - BALLX, U - BALLY), 2πNEXT UπFOR U = -200 TO 1000 STEP 300πLINE (U - BALLX, -20 - BALLY)-(U - BALLX, 580 - BALLY), 2πNEXT UπLINE (-200 - BALLX, -20 - BALLY)-(-200 - BALLX, -40 - BALLY), 15πLINE (-200 - BALLX, -40 - BALLY)-(-185 - BALLX, -40 - BALLY), 4πLINE (-185 - BALLX, -40 - BALLY)-(-200 - BALLX, -60 - BALLY), 4πLINE (-200 - BALLX, -60 - BALLY)-(-200 - BALLX, -40 - BALLY), 4πPAINT (-195 - BALLX, -45 - BALLY), 4, 4πLINE (1000 - BALLX, -20 - BALLY)-(1000 - BALLX, -40 - BALLY), 15πLINE (1000 - BALLX, -40 - BALLY)-(1015 - BALLX, -40 - BALLY), 4πLINE (1015 - BALLX, -40 - BALLY)-(1000 - BALLX, -60 - BALLY), 4πLINE (1000 - BALLX, -60 - BALLY)-(1000 - BALLX, -40 - BALLY), 4πPAINT (1005 - BALLX, -45 - BALLY), 4, 4πLINE (-200 - BALLX, 580 - BALLY)-(-200 - BALLX, 560 - BALLY), 15πLINE (-200 - BALLX, 560 - BALLY)-(-185 - BALLX, 560 - BALLY), 4πLINE (-185 - BALLX, 560 - BALLY)-(-200 - BALLX, 540 - BALLY), 4πLINE (-200 - BALLX, 540 - BALLY)-(-200 - BALLX, 560 - BALLY), 4πPAINT (-195 - BALLX, 555 - BALLY), 4, 4πLINE (1000 - BALLX, 580 - BALLY)-(1000 - BALLX, 560 - BALLY), 15πLINE (1000 - BALLX, 560 - BALLY)-(1015 - BALLX, 560 - BALLY), 4πLINE (1015 - BALLX, 560 - BALLY)-(1000 - BALLX, 540 - BALLY), 4πLINE (1000 - BALLX, 540 - BALLY)-(1000 - BALLX, 560 - BALLY), 4πPAINT (1005 - BALLX, 555 - BALLY), 4, 4πLINE (398 - BALLX, -20 - BALLY)-(398 - BALLX, 580 - BALLY), 15πLINE (400 - BALLX, -20 - BALLY)-(400 - BALLX, 580 - BALLY), 15πLINE (402 - BALLX, -20 - BALLY)-(402 - BALLX, 580 - BALLY), 15πCIRCLE (400 - BALLX, 280 - BALLY), 100, 15πCIRCLE (400 - BALLX, 280 - BALLY), 103, 15πLINE (0 - BALLX, 80 - BALLY)-(0 - BALLX, 480 - BALLY), 15πLINE (-2 - BALLX, 80 - BALLY)-(-2 - BALLX, 480 - BALLY), 15πLINE (2 - BALLX, 80 - BALLY)-(2 - BALLX, 480 - BALLY), 15πLINE (800 - BALLX, 80 - BALLY)-(800 - BALLX, 480 - BALLY), 15πLINE (798 - BALLX, 80 - BALLY)-(798 - BALLX, 480 - BALLY), 15πLINE (802 - BALLX, 80 - BALLY)-(802 - BALLX, 480 - BALLY), 15πLINE (-200 - BALLX, 82 - BALLY)-(2 - BALLX, 82 - BALLY), 15πLINE (-200 - BALLX, 80 - BALLY)-(2 - BALLX, 80 - BALLY), 15πLINE (-200 - BALLX, 78 - BALLY)-(2 - BALLX, 78 - BALLY), 15πLINE (798 - BALLX, 82 - BALLY)-(1000 - BALLX, 82 - BALLY), 15πLINE (798 - BALLX, 80 - BALLY)-(1000 - BALLX, 80 - BALLY), 15πππLINE (798 - BALLX, 78 - BALLY)-(1000 - BALLX, 78 - BALLY), 15πLINE (-200 - BALLX, 482 - BALLY)-(2 - BALLX, 482 - BALLY), 15πLINE (-200 - BALLX, 480 - BALLY)-(2 - BALLX, 480 - BALLY), 15πLINE (-200 - BALLX, 478 - BALLY)-(2 - BALLX, 478 - BALLY), 15πLINE (798 - BALLX, 482 - BALLY)-(1000 - BALLX, 482 - BALLY), 15πLINE (798 - BALLX, 480 - BALLY)-(1000 - BALLX, 480 - BALLY), 15πLINE (798 - BALLX, 478 - BALLY)-(1000 - BALLX, 478 - BALLY), 15πFOR U = 1000 TO 1075 STEP 25πLINE (U - BALLX, 180 - BALLY + ((U - 1000) / 3) - 25)-(U - BALLX, 380 - BALLY + ((U - 1000) / 3) - 25), 14πNEXT U: FOR U = 155 TO 355 STEP 50πLINE (1000 - BALLX, U - BALLY)-(1075 - BALLX, U - BALLY + 25), 14πNEXT UπLINE (1000 - BALLX, 180 - BALLY)-(1075 - BALLX, 180 - BALLY), 14πLINE (1000 - BALLX, 380 - BALLY)-(1075 - BALLX, 380 - BALLY), 14πLINE (1000 - BALLX, 355 - BALLY)-(1000 - BALLX, 380 - BALLY), 14πFOR U = -200 TO -275 STEP -25πLINE (U - BALLX, 180 - BALLY - ((U - -200) / 3) - 25)-(U - BALLX, 380 - BALLY - ((U - -200) / 3) - 25), 14πNEXT U: FOR U = 155 TO 355 STEP 50πLINE (-200 - BALLX, U - BALLY)-(-275 - BALLX, U - BALLY + 25), 14πNEXT UπLINE (-200 - BALLX, 180 - BALLY)-(-275 - BALLX, 180 - BALLY), 14πLINE (-200 - BALLX, 380 - BALLY)-(-275 - BALLX, 380 - BALLY), 14πLINE (-200 - BALLX, 355 - BALLY)-(-200 - BALLX, 380 - BALLY), 14πIF INTROER = 0 THEN PUT (305, 1), MINI%, PSETπCIRCLE (((FIELDER11X + 200) / 40) + 305, ((FIELDER11Y + 20) / 40) + 1), 2, SHIRT1πCIRCLE (((FIELDER12X + 200) / 40) + 305, ((FIELDER12Y + 20) / 40) + 1), 2, SHIRT1πCIRCLE (((FIELDER21X + 200) / 40) + 305, ((FIELDER21Y + 20) / 40) + 1), 2, SHIRT2πCIRCLE (((FIELDER22X + 200) / 40) + 305, ((FIELDER22Y + 20) / 40) + 1), 2, SHIRT2πCIRCLE (((-280 + 200) / 40) + 305, ((GOALY1 + 20) / 40) + 1), 2, SHIRT1πCIRCLE (((1000 + 200) / 40) + 305, ((GOALY2 + 20) / 40) + 1), 2, SHIRT2πRETURNπPLAYER: πLINE (X - 10 - BALLX, Y - 69 - BALLY)-(X + 15 - BALLX, Y - 67 - BALLY), 8πLINE (X + 15 - BALLX, Y - 67 - BALLY)-(X + 20 - BALLX, Y - 58 - BALLY), 8πLINE (X + 20 - BALLX, Y - 58 - BALLY)-(X + 25 - BALLX, Y - 55 - BALLY), 8πLINE (X + 25 - BALLX, Y - 55 - BALLY)-(X + 25 - BALLX, Y - 50 - BALLY), 8πLINE (X + 25 - BALLX, Y - 50 - BALLY)-(X + 20 - BALLX, Y - 51 - BALLY), 8πLINE (X + 20 - BALLX, Y - 51 - BALLY)-(X + 18 - BALLX, Y - 42 - BALLY), 8πLINE (X + 18 - BALLX, Y - 42 - BALLY)-(X + 11 - BALLX, Y - 39 - BALLY), 8πLINE (X + 11 - BALLX, Y - 39 - BALLY)-(X - BALLX, Y - 38 - BALLY), 8πLINE (X - BALLX, Y - 38 - BALLY)-(X - 9 - BALLX, Y - 41 - BALLY), 8πLINE (X - 9 - BALLX, Y - 41 - BALLY)-(X - 14 - BALLX, Y - 44 - BALLY), 8πLINE (X - 14 - BALLX, Y - 44 - BALLY)-(X - 18 - BALLX, Y - 50 - BALLY), 8πLINE (X - 18 - BALLX, Y - 50 - BALLY)-(X - 19 - BALLX, Y - 61 - BALLY), 8πLINE (X - 19 - BALLX, Y - 61 - BALLY)-(X - 14 - BALLX, Y - 65 - BALLY), 8πLINE (X - 14 - BALLX, Y - 65 - BALLY)-(X - 10 - BALLX, Y - 69 - BALLY), 8πLINE (X - 12 - BALLX, Y - 40 - BALLY)-(X - 10 - BALLX, Y - 39 - BALLY), 8πPAINT (X - BALLX, Y - 55 - BALLY), 12, 8πLINE (X + 13 - BALLX, Y - 50 - BALLY)-(X + 7 - BALLX, Y - 44 - BALLY), 8πππLINE (X + 7 - BALLX, Y - 44 - BALLY)-(X - 4 - BALLX, Y - 44 - BALLY), 8πLINE (X - 4 - BALLX, Y - 44 - BALLY)-(X - 10 - BALLX, Y - 50 - BALLY), 8πLINE (X - BALLX, Y - 51 - BALLY)-(X - 10 - BALLX, Y - 52 - BALLY), 8πLINE (X - 10 - BALLX, Y - 52 - BALLY)-(X - 15 - BALLX, Y - 59 - BALLY), 8πLINE (X - 15 - BALLX, Y - 59 - BALLY)-(X - 9 - BALLX, Y - 57 - BALLY), 8πLINE (X - 9 - BALLX, Y - 57 - BALLY)-(X - BALLX, Y - 54 - BALLY), 8πLINE (X - BALLX, Y - 54 - BALLY)-(X + 3 - BALLX, Y - 63 - BALLY), 8πCIRCLE (X - 3 - BALLX, Y - 60 - BALLY), 3, 8πCIRCLE (X + 7 - BALLX, Y - 60 - BALLY), 3, 8πPAINT (X - 3 - BALLX, Y - 60 - BALLY), 1, 8πPAINT (X + 7 - BALLX, Y - 60 - BALLY), 1, 8πLINE (X + 15 - BALLX, Y - 67 - BALLY)-(X + 11 - BALLX, Y - 74 - BALLY), 8πLINE (X + 11 - BALLX, Y - 74 - BALLY)-(X + 2 - BALLX, Y - 81 - BALLY), 8πLINE (X + 2 - BALLX, Y - 81 - BALLY)-(X + 4 - BALLX, Y - 73 - BALLY), 8πLINE (X + 4 - BALLX, Y - 73 - BALLY)-(X - 6 - BALLX, Y - 80 - BALLY), 8πLINE (X - 6 - BALLX, Y - 80 - BALLY)-(X - 10 - BALLX, Y - 76 - BALLY), 8πLINE (X - 10 - BALLX, Y - 76 - BALLY)-(X - 2 - BALLX, Y - 71 - BALLY), 8πLINE (X - 2 - BALLX, Y - 71 - BALLY)-(X - 14 - BALLX, Y - 73 - BALLY), 8πLINE (X - 14 - BALLX, Y - 73 - BALLY)-(X - 15 - BALLX, Y - 70 - BALLY), 8πLINE (X - 15 - BALLX, Y - 70 - BALLY)-(X - 10 - BALLX, Y - 69 - BALLY), 8πPAINT (X - BALLX, Y - 70 - BALLY), 14, 8πLINE (X + 8 - BALLX, Y - 38 - BALLY)-(X + 10 - BALLX, Y - 20 - BALLY), 8πLINE (X + 10 - BALLX, Y - 20 - BALLY)-(X - 13 - BALLX, Y - 20 - BALLY), 8πLINE (X - 13 - BALLX, Y - 20 - BALLY)-(X - 9 - BALLX, Y - 39 - BALLY), 8πPAINT (X - BALLX, Y - 30 - BALLY), SHIRT, 8πLINE (X - 9 - BALLX, Y - 39 - BALLY)-(X - 15 - BALLX, Y - 36 - BALLY), 8πLINE (X - 15 - BALLX, Y - 36 - BALLY)-(X - 11 - BALLX, Y - 30 - BALLY), 8πPAINT (X - 12 - BALLX, Y - 35 - BALLY), SHIRT, 8πLINE (X + 11 - BALLX, Y - 39 - BALLY)-(X + 15 - BALLX, Y - 36 - BALLY), 8πLINE (X + 15 - BALLX, Y - 36 - BALLY)-(X + 10 - BALLX, Y - 32 - BALLY), 8πPAINT (X + 10 - BALLX, Y - 34 - BALLY), SHIRT, 8πLINE (X - 9 - BALLX, Y - 20 - BALLY)-(X - 12 - BALLX, Y - 14 - BALLY), 8πLINE (X - 12 - BALLX, Y - 14 - BALLY)-(X - BALLX, Y - 11 - BALLY), 8πLINE (X - BALLX, Y - 11 - BALLY)-(X - BALLX, Y - 20 - BALLY), 8πPAINT (X - 5 - BALLX, Y - 15 - BALLY), PANTS, 8πLINE (X - BALLX, Y - 20 - BALLY)-(X + 3 - BALLX, Y - 11 - BALLY), 8πLINE (X + 3 - BALLX, Y - 11 - BALLY)-(X + 11 - BALLX, Y - 12 - BALLY), 8πLINE (X + 11 - BALLX, Y - 12 - BALLY)-(X + 9 - BALLX, Y - 20 - BALLY), 8πPAINT (X + 5 - BALLX, Y - 15 - BALLY), PANTS, 8πLINE (X - 9 - BALLX, Y - 12 - BALLY)-(X - 7 - BALLX, Y - 5 - BALLY), 8πLINE (X - 7 - BALLX, Y - 5 - BALLY)-(X - BALLX, Y - 2 - BALLY), 8πLINE (X - BALLX, Y - 2 - BALLY)-(X - 1 - BALLX, Y - 10 - BALLY), 8πPAINT (X - 3 - BALLX, Y - 6 - BALLY), 12, 8πLINE (X - BALLX, Y - 3 - BALLY)-(X - 4 - BALLX, Y + 1 - BALLY), 8πLINE (X - BALLX, Y - 2 - BALLY)-(X - 4 - BALLX, Y + 2 - BALLY), 8πLINE (X - BALLX, Y - 1 - BALLY)-(X - 4 - BALLX, Y + 3 - BALLY), 8πLINE (X + 6 - BALLX, Y - 11 - BALLY)-(X + 3 - BALLX, Y - 3 - BALLY), 8πLINE (X + 3 - BALLX, Y - 3 - BALLY)-(X + 10 - BALLX, Y - 6 - BALLY), 8πLINE (X + 10 - BALLX, Y - 6 - BALLY)-(X + 11 - BALLX, Y - 11 - BALLY), 8πPAINT (X + 8 - BALLX, Y - 7 - BALLY), 12, 8πLINE (X + 3 - BALLX, Y - 3 - BALLY)-(X + 8 - BALLX, Y + 1 - BALLY), 8πLINE (X + 3 - BALLX, Y - 2 - BALLY)-(X + 8 - BALLX, Y + 2 - BALLY), 8πLINE (X + 3 - BALLX, Y - 1 - BALLY)-(X + 8 - BALLX, Y + 3 - BALLY), 8πLINE (X - 14 - BALLX, Y - 35 - BALLY)-(X - 18 - BALLX, Y - 30 - BALLY), 8πLINE (X - 18 - BALLX, Y - 30 - BALLY)-(X - 20 - BALLX, Y - 32 - BALLY), 8πLINE (X - 20 - BALLX, Y - 32 - BALLY)-(X - 22 - BALLX, Y - 30 - BALLY), 8πLINE (X - 22 - BALLX, Y - 30 - BALLY)-(X - 25 - BALLX, Y - 31 - BALLY), 8πLINE (X - 25 - BALLX, Y - 31 - BALLY)-(X - 25 - BALLX, Y - 28 - BALLY), 8πLINE (X - 25 - BALLX, Y - 28 - BALLY)-(X - 20 - BALLX, Y - 26 - BALLY), 8πππLINE (X - 20 - BALLX, Y - 26 - BALLY)-(X - 23 - BALLX, Y - 24 - BALLY), 8πLINE (X - 23 - BALLX, Y - 24 - BALLY)-(X - 20 - BALLX, Y - 22 - BALLY), 8πLINE (X - 20 - BALLX, Y - 22 - BALLY)-(X - 16 - BALLX, Y - 25 - BALLY), 8πLINE (X - 16 - BALLX, Y - 25 - BALLY)-(X - 12 - BALLX, Y - 20 - BALLY), 8πLINE (X - 13 - BALLX, Y - 25 - BALLY)-(X - 15 - BALLX, Y - 28 - BALLY), 8πLINE (X - 15 - BALLX, Y - 28 - BALLY)-(X - 10 - BALLX, Y - 32 - BALLY), 8πPAINT (X - 18 - BALLX, Y - 28 - BALLY), 12, 8πLINE (X + 14 - BALLX, Y - 35 - BALLY)-(X + 19 - BALLX, Y - 31 - BALLY), 8πLINE (X + 19 - BALLX, Y - 31 - BALLY)-(X + 20 - BALLX, Y - 35 - BALLY), 8πLINE (X + 20 - BALLX, Y - 35 - BALLY)-(X + 22 - BALLX, Y - 31 - BALLY), 8πLINE (X + 22 - BALLX, Y - 31 - BALLY)-(X + 25 - BALLX, Y - 32 - BALLY), 8πLINE (X + 25 - BALLX, Y - 32 - BALLY)-(X + 23 - BALLX, Y - 29 - BALLY), 8πLINE (X + 23 - BALLX, Y - 29 - BALLY)-(X + 25 - BALLX, Y - 26 - BALLY), 8πLINE (X + 25 - BALLX, Y - 26 - BALLY)-(X + 18 - BALLX, Y - 25 - BALLY), 8πLINE (X + 18 - BALLX, Y - 25 - BALLY)-(X + 15 - BALLX, Y - 23 - BALLY), 8πLINE (X + 15 - BALLX, Y - 23 - BALLY)-(X + 15 - BALLX, Y - 26 - BALLY), 8πLINE (X + 15 - BALLX, Y - 26 - BALLY)-(X + 11 - BALLX, Y - 31 - BALLY), 8πPAINT (X + 15 - BALLX, Y - 31 - BALLY), 12, 8πRETURNπINSTRUCTIONS: πCLS : PAINT (320, 175), 15: X = 250: Y = 0πGOSUB STRIKER: LOCATE 15, 7πPRINT "Hi there! I'm Striker, the U.S. ";πPRINT "Soccer Team's mascot. But enough"πLOCATE 16, 7: PRINT "with the small-talk, I'm ";πPRINT "here to teach you how to play World Cup "πLOCATE 17, 7: PRINT "94. World Cup 94 is played ";πPRINT "like a regular soccer game in which "πLOCATE 18, 7: PRINT "players try to kick the soccer ";πPRINT "ball into the opposing teams goal. "πLOCATE 19, 7: PRINT "Each time the ball is kicked ";πPRINT "into the opposing teams goal, the "πLOCATE 20, 7: PRINT "player who kicked the ball's ";πPRINT "team will receive a point. Whichever"πLOCATE 21, 7: PRINT "team receives three points ";πPRINT "first;wins!. "πLOCATE 23, 7: INPUT "Press return", A$: CLSπPAINT (320, 175), 15: X = 250: Y = 0πGOSUB STRIKER: LOCATE 15, 7πPRINT "In World Cup 94 each team consists ";πPRINT "of 3 players; 2 field players "πLOCATE 16, 7: PRINT "and 1 goalie. You can ";πPRINT "select from 24 different teams to play as. "πLOCATE 17, 7: PRINT "All teams have actual player's ";πPRINT "names that played in World Cup 94. "πLOCATE 23, 7: INPUT "Press return", A$: CLSπPAINT (320, 175), 15: X = 250: Y = -9πGOSUB STRIKER: LOCATE 14, 7πPRINT "The controls for all 6 players ";πPRINT "are as follows: "πLOCATE 15, 7: PRINT " control | 1 | 2 ";πPRINT " | 3 | 4 | 5 | 6 "πLOCATE 16, 7: PRINT " |goalie1|fielder1";πPRINT "|fielder1|goalie2|fielder2|fielder2 "πππLOCATE 17, 7: PRINT "-------------------------------";πPRINT "-----------------------------------"πLOCATE 18, 7: PRINT " up | 1 | E ";πPRINT "| U | - | [ | 8 "πLOCATE 19, 7: PRINT " left | N/A | ";πPRINT "S | H | N/A | ; | 4 "πLOCATE 20, 7: PRINT " down | Q | ";πPRINT "X | N | + | / | 2 "πLOCATE 21, 7: PRINT " right | N/A | ";πPRINT "D | J | N/A | ' | 6 "πLOCATE 22, 7: PRINT " shoot/kick | ` | ";πPRINT "R | I | * | ] | 9 "πLOCATE 23, 7: PRINT " pass | N/A | ";πPRINT "W | Y | N/A | P | 7 "πLOCATE 24, 7: INPUT "Press return", A$πRETURNπCONTROLS: πLPRINT "The controls for all 6 players ";πLPRINT "are as follows: "πLPRINT " control | 1 | 2 ";πLPRINT " | 3 | 4 | 5 | 6 "πLPRINT " |goalie1|fielder1";πLPRINT "|fielder1|goalie2|fielder2|fielder2 "πLPRINT "-------------------------------";πLPRINT "-----------------------------------"πLPRINT " up | 1 | E ";πLPRINT "| U | - | [ | 8 "πLPRINT " left | N/A | ";πLPRINT "S | H | N/A | ; | 4 "πLPRINT " down | Q | ";πLPRINT "X | N | + | / | 2 "πLPRINT " right | N/A | ";πLPRINT "D | J | N/A | ' | 6 "πLPRINT " shoot/kick | ` | ";πLPRINT "R | I | * | ] | 9 "πLPRINT " pass | N/A | ";πLPRINT "W | Y | N/A | P | 7 "πRETURNπSELECTION: πCLS : FOR G = 1 TO 100: LOCATE 12, 33πPRINT "Team Selection": FOR T = 1 TO 50: NEXT TπLOCATE 12, 33: PRINT " ": FOR T = 1 TO 50πNEXT T: NEXT G: CLS : PL = 1: NUMBER = 1: PICKED = 0π10010 K = 0πIF NUMBER = PICKED THENπ IF A$ = "4" THENπ NUMBER = NUMBER - 1π ELSEπ NUMBER = NUMBER + 1π END IFπEND IFπIF NUMBER < 1 THEN NUMBER = 24πIF NUMBER > 24 THEN NUMBER = 1πIF NUMBER = PICKED THENπππ IF A$ = "4" THENπ NUMBER = NUMBER - 1π ELSEπ NUMBER = NUMBER + 1π END IFπEND IFπIF NUMBER < 1 THEN NUMBER = 23πIF NUMBER > 24 THEN NUMBER = 2πIF NUMBER = 1 THEN COUNTRY$ = "U.S.A.": GOSUB USAπIF NUMBER = 2 THEN COUNTRY$ = "Switzerland": GOSUB SWITZERLANDπIF NUMBER = 3 THEN COUNTRY$ = "Romania": GOSUB ROMANIAπIF NUMBER = 4 THEN COUNTRY$ = "Colombia": GOSUB COLOMBIAπIF NUMBER = 5 THEN COUNTRY$ = "Brazil": GOSUB BRAZILπIF NUMBER = 6 THEN COUNTRY$ = "Cameroon": GOSUB CAMEROONπIF NUMBER = 7 THEN COUNTRY$ = "Sweden": GOSUB SWEDENπIF NUMBER = 8 THEN COUNTRY$ = "Russia": GOSUB RUSSIAπIF NUMBER = 9 THEN COUNTRY$ = "Germany": GOSUB GERMANYπIF NUMBER = 10 THEN COUNTRY$ = "Spain": GOSUB SPAINπIF NUMBER = 11 THEN COUNTRY$ = "South Korea": GOSUB SOUTHKOREAπIF NUMBER = 12 THEN COUNTRY$ = "Bolivia": GOSUB BOLIVIAπIF NUMBER = 13 THEN COUNTRY$ = "Argentina": GOSUB ARGENTINAπIF NUMBER = 14 THEN COUNTRY$ = "Nigeria": GOSUB NIGERIAπIF NUMBER = 15 THEN COUNTRY$ = "Bulgaria": GOSUB BULGARIAπIF NUMBER = 16 THEN COUNTRY$ = "Greece": GOSUB GREECEπIF NUMBER = 17 THEN COUNTRY$ = "Ireland": GOSUB IRELANDπIF NUMBER = 18 THEN COUNTRY$ = "Norway": GOSUB NORWAYπIF NUMBER = 19 THEN COUNTRY$ = "Italy": GOSUB ITALYπIF NUMBER = 20 THEN COUNTRY$ = "Mexico": GOSUB MEXICOπIF NUMBER = 21 THEN COUNTRY$ = "Belgium": GOSUB BELGIUMπIF NUMBER = 22 THEN COUNTRY$ = "Netherlands": GOSUB NETHERLANDSπIF NUMBER = 23 THEN COUNTRY$ = "Saudi Arabia": GOSUB SAUDIARABIAπIF NUMBER = 24 THEN COUNTRY$ = "Morocco": GOSUB MOROCCOπLOCATE 22, 11: PRINT "'4' or '6' to see a different ";πPRINT "team, '5' to select this team"πLOCATE 24, 20: PRINT "What is your choice, player"; PL;πA$ = " "π10015 A$ = INKEY$πIF A$ <> "4" AND A$ <> "5" AND A$ <> "6" THEN GOTO 10015πIF A$ = "4" THEN NUMBER = NUMBER - 1: GOTO 10010πIF A$ = "6" THEN NUMBER = NUMBER + 1: GOTO 10010πIF A$ = "5" THENπ IF PL = 1 THENπ HANDS1 = HANDS: NAME11$ = NAME1$: NAME12$ = NAME2$π GOALIE1$ = GOALIE$: STEAL1 = STEAL: SPEED1 = SPEEDπ K = 1: COUNTRY1$ = COUNTRY$: PICKED = NUMBERπ ELSEπ NAME21$ = NAME1$: NAME22$ = NAME2$π GOALIE2$ = GOALIE$: COUNTRY2$ = COUNTRY$π STEAL2 = STEAL: SPEED2 = SPEED: HANDS2 = HANDS: K = 2π END IFπEND IFπIF K = 1 THEN PL = 2: NUMBER = 1πIF K <> 2 THEN GOTO 10010πCLS : FOR G = 1 TO 100πππLOCATE 12, 31: PRINT "Uniform Selection"πFOR T = 1 TO 40: NEXT TπLOCATE 12, 32: PRINT " "πFOR T = 1 TO 40: NEXT T: NEXT G: CLS : PL = 1π10020 CLS : LOCATE 2, 31: PRINT "Color number chart"πLOCATE 3, 20πPRINT "-----------------------------------------"πLOCATE 4, 20: PRINT "0 = black | 6 = brown"πLOCATE 5, 20: PRINT "1 = blue | 8 = gray"πLOCATE 6, 20πPRINT "2=green(only w/shorts)| 9 = light blue"πLOCATE 7, 20πPRINT "3 = cyan | 10 = light green"πLOCATE 8, 20πPRINT "4 = red | 11 = light cyan"πLOCATE 9, 20πPRINT "5 = magenta | 14 = yellow"πLOCATE 10, 20: PRINT " | 15 = white"πLOCATE 12, 20πPRINT "-----------------------------------------"πLOCATE 13, 20πPRINT "What color jersey do you want player"; PL;πINPUT SHIRT: LOCATE 14, 20πPRINT "What color shorts do you want player"; PL;πINPUT PANTSπIF SHIRT <> 15 AND SHIRT <> 0 AND SHIRT <> 1 AND SHIRT <> 3 AND SHIRT <> 4 AND SHIRT <> 5 AND SHIRT <> 8 AND SHIRT <> 9 AND SHIRT <> 10 AND SHIRT <> 11 AND SHIRT <> 14 AND SHIRT <> 6 THEN LOCATE 16, 25: PRINT "You entered a non-valid shirt color": INPUT A$: GOTO 10020πIF PANTS <> 15 AND PANTS <> 0 AND PANTS <> 1 AND PANTS <> 2 AND PANTS <> 3 AND PANTS <> 4 AND PANTS <> 5 AND PANTS <> 8 AND PANTS <> 9 AND PANTS <> 10 AND PANTS <> 11 AND PANTS <> 14 AND PANTS <> 6 THEN LOCATE 16, 25: PRINT "You entered a non-valid shorts color": INPUT A$: GOTO 10020π10030 CLS : GOSUB DEMO: LOCATE 17, 23πPRINT "Does this look okay, player"; PL; : INPUT A$πIF A$ = "N" OR A$ = "NO" THEN GOTO 10020πIF A$ = "Y" OR A$ = "YE" OR A$ = "YES" THEN GOTO 10040πGOTO 10030π10040 IF PL = 1 THENπ SHIRT1 = SHIRT: PANTS1 = PANTS: PL = 2: BALLX = -320π BALLY = -175: DIM GUY1%(1 TO 2000)π GET (290, 90)-(350, 180), GUY1%: GOTO 10020πEND IFπDIM GUY2%(1 TO 2000): GET (290, 90)-(350, 180), GUY2%πSHIRT2 = SHIRT: PANTS2 = PANTS: SCORE1 = 0: SCORE2 = 0πCLS : LOCATE 12, 18πPRINT "Make sure that Caps Lock and Num Lock are on"πFOR T = 1 TO 15000: NEXT TπRETURNπDEMO: πBALLX = -320: BALLY = -175: X = 0: Y = 0: GOSUB PLAYERπRETURNπMAINGAME: πππ12000 BALLX = 80: BALLY = 105: GOALY1 = 280πGOALY2 = 280: FIELDER11X = 300: FIELDER12X = 300πFIELDER11Y = 230: FIELDER12Y = 330: FIELDER21X = 500πFIELDER22X = 500: FIELDER21Y = 230: FIELDER22Y = 330πCONTROL = 0: POWER = 0: PREV = 0: GOAL1 = 0: GOAL2 = 0πSCREEN 9, , 0, 0: CLS : PCOPY 0, 1π20000 SCREEN 9, , 0, 1: GOSUB DRAWSTUFFπIF GOAL1 = 1 OR GOAL2 = 1 THEN SCREEN 9, , 0, 0: GOTO 50000πSCREEN 9, , 0, 0: PCOPY 0, 1πC$ = " "πC$ = INKEY$π20010 IF C$ <> " " THEN GOSUB INTERPRETπIF POWER < 0 THEN PREV = 0πIF POWER > 0 THEN BALLX = BALLX + DX: BALLY = BALLY + DYπIF POWER > -4 THEN POWER = POWER - 1πLET NUM = INT(RND(1) * 125) + 1πIF BALLX + 320 > FIELDER11X - 16 AND BALLX + 320 < FIELDER11X + 16 AND BALLY + 175 > FIELDER11Y - 16 AND BALLY + 175 < FIELDER11Y + 16 AND NUM < STEAL1 THEN CONTROL = 2πIF BALLX + 320 > FIELDER12X - 16 AND BALLX + 320 < FIELDER12X + 16 AND BALLY + 175 > FIELDER12Y - 16 AND BALLY + 175 < FIELDER12Y + 16 AND NUM < STEAL1 THEN CONTROL = 3πIF BALLX + 320 > FIELDER21X - 16 AND BALLX + 320 < FIELDER21X + 16 AND BALLY + 175 > FIELDER21Y - 16 AND BALLY + 175 < FIELDER21Y + 16 AND NUM < STEAL2 THEN CONTROL = 5πIF BALLX + 320 > FIELDER22X - 16 AND BALLX + 320 < FIELDER22X + 16 AND BALLY + 175 > FIELDER22Y - 16 AND BALLY + 175 < FIELDER22Y + 16 AND NUM < STEAL2 THEN CONTROL = 6πIF (NUM - 40) < HANDS1 AND BALLX + 320 > -180 - 40 AND BALLX + 320 < -180 + 60 AND BALLY + 175 > GOALY1 - 100 AND BALLY + 175 < GOALY1 + 40 THEN CONTROL = 1πIF (NUM - 40) < HANDS2 AND BALLX + 320 > 980 - 60 AND BALLX + 320 < 980 + 40 AND BALLY + 175 > GOALY2 - 100 AND BALLY + 175 < GOALY2 + 40 THEN CONTROL = 4πIF CONTROL = 2 AND PREV <> 2 THENπ BALLX = FIELDER11X - 320π BALLY = FIELDER11Y - 175: DX = 0: DY = 0πEND IFπIF CONTROL = 3 AND PREV <> 3 THENπ BALLX = FIELDER12X - 320π BALLY = FIELDER12Y - 175: DX = 0: DY = 0πEND IFπIF CONTROL = 5 AND PREV <> 5 THENπ BALLX = FIELDER21X - 320π BALLY = FIELDER21Y - 175: DX = 0: DY = 0πEND IFπIF CONTROL = 6 AND PREV <> 6 THENπ BALLX = FIELDER22X - 320π BALLY = FIELDER22Y - 175: DX = 0: DY = 0πEND IFπIF CONTROL = 4 AND PREV <> 4 THENπ BALLX = 920 - 320: BALLY = GOALY2 - 175πEND IFπIF CONTROL = 1 AND PREV <> 1 THENπ BALLX = -120 - 320: BALLY = GOALY1 - 175πEND IFπIF GOALY1 > 580 THEN GOALY1 = 580πIF GOALY1 < -20 THEN GOALY1 = -20πIF GOALY2 > 580 THEN GOALY2 = 580πππIF GOALY2 < -20 THEN GOALY2 = -20πIF FIELDER11X > 1000 THEN FIELDER11X = 1000πIF FIELDER11X < -200 THEN FIELDER11X = -200πIF FIELDER11Y > 580 THEN FIELDER11Y = 580πIF FIELDER11Y < -20 THEN FIELDER11Y = -20πIF FIELDER12X > 1000 THEN FIELDER12X = 1000πIF FIELDER12X < -200 THEN FIELDER12X = -200πIF FIELDER12Y > 580 THEN FIELDER12Y = 580πIF FIELDER12Y < -20 THEN FIELDER12Y = -20πIF FIELDER21X > 1000 THEN FIELDER21X = 1000πIF FIELDER21X < -200 THEN FIELDER21X = -200πIF FIELDER21Y > 580 THEN FIELDER21Y = 580πIF FIELDER21Y < -20 THEN FIELDER21Y = -20πIF FIELDER22X > 1000 THEN FIELDER22X = 1000πIF FIELDER22X < -200 THEN FIELDER22X = -200πIF FIELDER22Y > 580 THEN FIELDER22Y = 580πIF FIELDER22Y < -20 THEN FIELDER22Y = -20πIF BALLY < -195 THEN BALLY = -195πIF BALLY > 405 THEN BALLY = 405πIF BALLY < 5 AND BALLX < -520 THEN BALLX = -520πIF BALLY > 205 AND BALLX < -520 THEN BALLX = -520πIF BALLY < 5 AND BALLX > 680 THEN BALLX = 680πIF BALLY > 205 AND BALLX > 680 THEN BALLX = 680πIF BALLX < -520 THEN GOAL1 = 1πIF BALLX > 680 THEN GOAL2 = 1πGOTO 20000πRETURNπDRAWSTUFF: πGOSUB SOCCERFIELDπIF FIELDER11X > BALLX + 35 AND FIELDER11X < BALLX + 605 AND FIELDER11Y > BALLY + 90 AND FIELDER11Y < BALLY + 340 THENπ PUT (FIELDER11X - 30 - BALLX, FIELDER11Y - 90 - BALLY), GUY1%, ORπEND IFπIF FIELDER12X > BALLX + 35 AND FIELDER12X < BALLX + 605 AND FIELDER12Y > BALLY + 90 AND FIELDER12Y < BALLY + 340 THENπ PUT (FIELDER12X - 30 - BALLX, FIELDER12Y - 90 - BALLY), GUY1%, ORπEND IFπIF FIELDER21X > BALLX + 35 AND FIELDER21X < BALLX + 605 AND FIELDER21Y > BALLY + 90 AND FIELDER21Y < BALLY + 340 THENπ PUT (FIELDER21X - 30 - BALLX, FIELDER21Y - 90 - BALLY), GUY2%, ORπEND IFπIF FIELDER22X > BALLX + 35 AND FIELDER22X < BALLX + 605 AND FIELDER22Y > BALLY + 90 AND FIELDER22Y < BALLY + 340 THENπ PUT (FIELDER22X - 30 - BALLX, FIELDER22Y - 90 - BALLY), GUY2%, ORπEND IFπIF -180 > BALLX + 35 AND -180 < BALLX + 605 AND GOALY1 > BALLY + 90 AND GOALY1 < BALLY + 340 THENπ PUT (-180 - 30 - BALLX, GOALY1 - 90 - BALLY), GUY1%, ORπEND IFπIF 980 > BALLX + 35 AND 980 < BALLX + 605 AND GOALY2 > BALLY + 90 AND GOALY2 < BALLY + 340 THENπ PUT (980 - 30 - BALLX, GOALY2 - 90 - BALLY), GUY2%, ORπEND IFπRETURNπINTERPRET: πLET NU = INT(RND(1) * 5) + 1πππIF NU = 1 THEN NUM = -99πIF NU = 2 THEN NUM = 99πIF NU = 3 THEN NUM = 0πIF NU = 4 THEN NUM = 50πIF NU = 5 THEN NUM = -50πIF C$ = "1" THEN GOALY1 = GOALY1 - 10 - SPEED1πIF C$ = "Q" THEN GOALY1 = GOALY1 + 10 + SPEED1πIF C$ = "`" AND CONTROL = 1 THENπ POWER = 40: DX = 20π LET DY = ((INT(RND(1) * 600)) - 300) / POWERπ CONTROL = 0: PREV = 1: BALLX = BALLX + 20πEND IFπIF C$ = "E" THEN FIELDER11Y = FIELDER11Y - 10 - SPEED1πIF C$ = "S" THEN FIELDER11X = FIELDER11X - 10 - SPEED1πIF C$ = "X" THEN FIELDER11Y = FIELDER11Y + 10 + SPEED1πIF C$ = "D" THEN FIELDER11X = FIELDER11X + 10 + SPEED1πIF C$ = "W" AND CONTROL = 2 THENπ POWER = 15π DX = (FIELDER11X - FIELDER12X) / (POWER * -1)π DY = (FIELDER11Y - FIELDER12Y) / (POWER * -1): PREV = 2π CONTROL = 0πEND IFπIF C$ = "R" AND CONTROL = 2 THENπ POWER = 17π DX = (FIELDER11X - 1010) / (POWER * -1)π DY = (FIELDER11Y - 280 + NUM) / (POWER * -1)π PREV = 2: CONTROL = 0πEND IFπIF C$ = "U" THEN FIELDER12Y = FIELDER12Y - 10 - SPEED1πIF C$ = "H" THEN FIELDER12X = FIELDER12X - 10 - SPEED1πIF C$ = "N" THEN FIELDER12Y = FIELDER12Y + 10 + SPEED1πIF C$ = "J" THEN FIELDER12X = FIELDER12X + 10 + SPEED1πIF C$ = "Y" AND CONTROL = 3 THENπ POWER = 15π DX = (FIELDER12X - FIELDER11X) / (POWER * -1)π DY = (FIELDER12Y - FIELDER11Y) / (POWER * -1)π PREV = 3: CONTROL = 0πEND IFπIF C$ = "I" AND CONTROL = 3 THENπ POWER = 17: DX = (FIELDER12X - 1010) / (POWER * -1)π DY = (FIELDER12Y - 280 + NUM) / (POWER * -1)π PREV = 3: CONTROL = 0πEND IFπIF C$ = "-" THEN GOALY2 = GOALY2 - 10 - SPEED2πIF C$ = "+" THEN GOALY2 = GOALY2 + 10 + SPEED2πIF C$ = "*" AND CONTROL = 4 THENπ POWER = 40: DX = -20π LET DY = ((INT(RND(1) * 600)) - 300) / POWERπ CONTROL = 0: PREV = 4: BALLX = BALLX - 20πEND IFπIF C$ = "[" THEN FIELDER21Y = FIELDER21Y - 10 - SPEED2πIF C$ = ";" THEN FIELDER21X = FIELDER21X - 10 - SPEED2πIF C$ = "/" THEN FIELDER21Y = FIELDER21Y + 10 + SPEED2πIF C$ = "'" THEN FIELDER21X = FIELDER21X + 10 + SPEED2πIF C$ = "P" AND CONTROL = 5 THENπ POWER = 15π DX = (FIELDER21X - FIELDER22X) / (POWER * -1)π DY = (FIELDER21Y - FIELDER22Y) / (POWER * -1)π PREV = 5: CONTROL = 0πEND IFπππIF C$ = "]" AND CONTROL = 5 THENπ POWER = 17: DX = (FIELDER21X + 210) / (POWER * -1)π DY = (FIELDER21Y - 280 + NUM) / (POWER * -1)π PREV = 5: CONTROL = 0πEND IFπIF C$ = "8" THEN FIELDER22Y = FIELDER22Y - 10 - SPEED2πIF C$ = "4" THEN FIELDER22X = FIELDER22X - 10 - SPEED2πIF C$ = "2" THEN FIELDER22Y = FIELDER22Y + 10 + SPEED2πIF C$ = "6" THEN FIELDER22X = FIELDER22X + 10 + SPEED2πIF C$ = "7" AND CONTROL = 6 THENπ POWER = 15π DX = (FIELDER22X - FIELDER21X) / (POWER * -1)π DY = (FIELDER22Y - FIELDER21Y) / (POWER * -1)π PREV = 6: CONTROL = 0πEND IFπIF C$ = "9" AND CONTROL = 6 THENπ POWER = 17: DX = (FIELDER22X + 210) / (POWER * -1)π DY = (FIELDER22Y - 280 + NUM) / (POWER * -1): PREV = 6: CONTROL = 0πEND IFπ40000 REM πIF ABS(DX) > 30 THEN DX = DX * .95: DY = DY * .95πIF ABS(DY) > 30 THEN DX = DX * .95: DY = DY * .95πIF ABS(DX) > 30 OR ABS(DY) > 30 THEN GOTO 40000πRETURNπ50000 REM GOAL πSCORER$ = "Z%": IF PREV = 1 THEN SCORER$ = GOALIE1$πIF PREV = 2 THEN SCORER$ = NAME11$πIF PREV = 3 THEN SCORER$ = NAME12$πIF PREV = 4 THEN SCORER$ = GOALIE2$πIF PREV = 5 THEN SCORER$ = NAME21$πIF PREV = 6 THEN SCORER$ = NAME22$πIF SCORER$ = "Z%" AND CONTROL = 1 THEN SCORER$ = GOALIE1$πIF SCORER$ = "Z%" AND CONTROL = 2 THEN SCORER$ = NAME11$πIF SCORER$ = "Z%" AND CONTROL = 3 THEN SCORER$ = NAME12$πIF SCORER$ = "Z%" AND CONTROL = 4 THEN SCORER$ = GOALIE2$πIF SCORER$ = "Z%" AND CONTROL = 5 THEN SCORER$ = NAME21$πIF SCORER$ = "Z%" AND CONTROL = 6 THEN SCORER$ = NAME22$πLOCATE 12, 36: PRINT "Goal!!!!": LOCATE 14, 25πIF SCORER$ <> "Z" THEN PRINT "Goal scored by ";πIF SCRORE$ <> "Z" THEN PRINT SCORER$; " !!!!!!"πFOR T1 = 1 TO 5: FOR T2 = 37 TO 14000 STEP 1000πSOUND T2, 1: NEXT T2: NEXT T1: FOR T1 = 1 TO 30πLET T2 = INT(RND(1) * 500) + 2000: SOUND T2, 1πNEXT T1: CLS : SCORE1 = SCORE1 + GOAL2πSCORE2 = SCORE2 + GOAL1: LOCATE 12, 30πPRINT COUNTRY1$; SCORE1; "-"; SCORE2; COUNTRY2$πFOR T3 = 1 TO 60000: NEXT T3πGOAL1 = 0: GOAL2 = 0πIF SCORE1 > 2 OR SCORE2 > 2 THEN GOTO 60000πGOTO 12000π60000 RETURNπENDππ'That's all Folks By A|@* Makris at CRPY26CπBen Kington SPACE MAN FRED comp.lang.basic.misc 08-21-96 (14:55) QB, QBasic, PDS 431 9197 SPACEMAN.BAS'Space Man Fred v 1.1π'by Ben Kingtonππshphlth = 60πagn:πskipinto:πRANDOMIZE TIMERπ'notes to my self:π'K=Leftπ'M=Rightπ'P=Downπ'H = Upπcokcol = 1πSCREEN 13ππa = 160 'Define some variablesπmis = 3πen = 5πenm = 1πenspd = 1πtimens = INT(TIMER + 120 - enspd)πenaway = 6πencol = 1πavt = 165πenv = 10πshphlth = 60πstarx1 = INT(RND * 319) + 1 'Make ten starsπstary1 = INT(RND * 199) + 1πstarx2 = INT(RND * 319) + 1πstary2 = INT(RND * 199) + 1πstarx3 = INT(RND * 319) + 1πstary3 = INT(RND * 199) + 1πstarx4 = INT(RND * 319) + 1πstary4 = INT(RND * 199) + 1πstarx5 = INT(RND * 319) + 1πstary5 = INT(RND * 199) + 1πstarx6 = INT(RND * 199) + 1πstary6 = INT(RND * 319) + 1πstarx7 = INT(RND * 199) + 1πstary7 = INT(RND * 319) + 1πstarx8 = INT(RND * 199) + 1πstary8 = INT(RND * 319) + 1πstarx9 = INT(RND * 199) + 1πstary9 = INT(RND * 319) + 1πstarx10 = INT(RND * 199) + 1πstary10 = INT(RND * 319) + 1πPSET (starx1, stary1), 15πPSET (starx2, stary1), 15πPSET (starx3, stary3), 15πPSET (starx4, stary4), 15πPSET (starx5, stary5), 15πPSET (stary6, starx6), 15πPSET (stary7, starx7), 15πPSET (stary8, starx8), 15πPSET (stary9, starx9), 15πPSET (stary10, starx10), 15πplanx = INT(RND * 290) + 30πplany = INT(RND * 170) + 30πpc = 1πrc = 4πDOπCOLOR 0πLINE (planx - 30, plany - 30)-(planx + 30, plany + 30), , BFπCOLOR 15πCIRCLE (planx, plany), 20, pcπPAINT (planx, plany - 15), pcπPAINT (planx, plany + 15), pcπCIRCLE (planx, plany), 30, rc, , , .1πLINE (planx - 17, plany - 3)-(planx + 17, plany - 3), pcπLINE (planx - 20, plany - 2)-(planx + 20, plany - 2), pcπplany = plany + 1πIF plany > 450 THENπplanx = INT(RND * 290) + 30πplany = 0πpc = INT(RND * 15) + 1πrc = INT(RND * 15) + 1πIF rc = pc THEN rc = INT(RND * 15) + 1πCOLOR 0πLINE (planx - 25, plany - 25)-(planx + 25, plany + 25), , BFπCOLOR 15πEND IFππPSET (starx1, stary1), 0πPSET (starx2, stary1), 0πPSET (starx1, stary1), 0πPSET (starx3, stary3), 0πPSET (starx4, stary4), 0πPSET (starx5, stary5), 0πPSET (stary6, starx6), 0πPSET (stary7, starx7), 0πPSET (stary8, starx8), 0πPSET (stary9, starx9), 0πPSET (stary10, starx10), 0ππstary1 = stary1 + 1πstary2 = stary2 + 2πstary3 = stary3 + 1πstary4 = stary4 + 1πstary5 = stary5 + 2πstarx6 = starx6 + 1πstarx7 = starx7 + 1πstarx8 = starx8 + 2πstarx9 = starx9 + 1πstarx10 = starx10 + 2πIF stary1 > 200 THENπstary1 = 0πstarx1 = INT(RND * 320) + 1πEND IFπIF stary2 > 200 THENπstary2 = 0πstarx2 = INT(RND * 320) + 1πEND IFπIF stary3 > 200 THENπstary3 = 0πstarx3 = INT(RND * 320) + 1πEND IFπIF stary4 > 200 THENπstary4 = 0πstarx4 = INT(RND * 320) + 1πEND IFπIF stary5 > 200 THENπstary5 = 0πstarx5 = INT(RND * 320) + 1πEND IFπIF starx6 > 200 THENπstarx6 = 0πstary6 = INT(RND * 320) + 1πEND IFπIF starx7 > 200 THENπstarx7 = 0πstary7 = INT(RND * 320) + 1πEND IFπIF starx8 > 200 THENπstarx8 = 0πstary8 = INT(RND * 320) + 1πEND IFπIF starx9 > 200 THENπstarx9 = 0πstary9 = INT(RND * 320) + 1πEND IFπIF starx10 > 200 THENπstarx10 = 0πstary10 = INT(RND * 320) + 1πEND IFπPSET (starx2, stary1), 15πPSET (starx3, stary3), 15πPSET (starx4, stary4), 15πPSET (starx5, stary5), 15πPSET (stary6, starx6), 15πPSET (stary7, starx7), 15πPSET (stary8, starx8), 15πPSET (stary9, starx9), 15πPSET (stary10, starx10), 15ππCOLOR 15πLINE (4, 185)-(66, 190), , BππCOLOR 1πLINE (5, 186)-(5 + shphlth, 189), , BFππtimen = INT(timens - TIMER)πCOLOR 15πLOCATE 1, 1πPRINT "Score: "; scr; " Timer:"; timen; " Missles:"; misπen1 = en - 5πen2 = en + 5πCOLOR 0πLINE (en1 - 1, env - 1)-(en2 + 1, env + 11), , BFπCOLOR encolπLINE (en1, env)-(en2, env) 'DRAW THE ENEMYπLINE (en1, env)-(en1, env + 5)πLINE (en2, env)-(en2, env + 5)πLINE (en2, env + 5)-(en1, env + 5)πLINE (en, env + 5)-(en, env + 10)πPAINT (en, env + 1)ππCHUNK$ = UCASE$(INKEY$)πb1 = a + 10πb2 = a - 10πc = b1 - 2πd = b2 + 2πavb = avt + 15πabh = avb - 2πSELECT CASE CHUNK$πCASE CHR$(0) + "M"πIF b1 <> 320 THEN a = a + 10π'SOUND 60, 1πCASE CHR$(0) + "K"πIF b2 <> 1 THEN a = a - 10π'SOUND 60, 1πCASE CHR$(0) + "P"πIF avt <> 190 THEN avt = avt + 5πCASE CHR$(0) + "H"πIF avt <> 10 THEN avt = avt - 5πCASE CHR$(32)πππSOUND 1000, 1π'LINE (a, avt)-(a, env), 4πCOLOR 15πLINE (a, avt)-(b1, avb) 'Draw the shipπLINE (a, avt)-(b2, avb)πLINE (c, abh)-(d, abh)πCIRCLE (a, avt + 5), 2, cokcolπPAINT (a, avt + 5), cokcolπshot = avtπDOπCOLOR 15πLINE (a, avt)-(b1, avb) 'Draw the shipπLINE (a, avt)-(b2, avb)πLINE (c, abh)-(d, abh)πCIRCLE (a, avt + 5), 2, cokcolπPAINT (a, avt + 5), cokcolππCIRCLE (a, shot + 5), 2, 0πCIRCLE (a, shot + 5), 1, 0πPSET (a, shot + 5), 0πPSET (a, shot), 4πCIRCLE (a, shot), 1, 44πCIRCLE (a, shot), 2, 111π'PLAY "p64"πfdel = TIMERπdel = TIMER + .004πDO: LOOP WHILE del > TIMERπshot = shot - 5πLOOP WHILE shot > envπππCIRCLE (a, shot + 5), 2, 0πCIRCLE (a, shot + 5), 1, 0πPSET (a, shot + 5), 0ππIF a > en1 - 3 AND a < en2 + 3 THEN ens = 2πCASE CHR$(48)πIF mis > 0 AND avt > env THENπLINE (a, avt)-(en, env), 2πSOUND 1000, 1πgoo = INT(TIMER)πgooer = goo + 1ππDOπLOOP WHILE gooer <> INT(TIMER)πmis = mis - 1πens = 2πLINE (a, avt)-(en, env), 0πEND IFπEND SELECTππCOLOR 0πLINE (b1 + 15, avt - 16)-(b2 - 15, avb + 16), , BFπCOLOR 15πLINE (a, avt)-(b1, avb) 'Draw the shipπLINE (a, avt)-(b2, avb)πLINE (c, abh)-(d, abh)πCIRCLE (a, avt + 5), 2, cokcolπPAINT (a, avt + 5), cokcolπen1 = en - 5πen2 = en + 5πCOLOR encolππLINE (en1, env)-(en2, env) 'DRAW THE ENEMYπLINE (en1, env)-(en1, env + 5)πLINE (en2, env)-(en2, env + 5)πLINE (en2, env + 5)-(en1, env + 5)πLINE (en, env + 5)-(en, env + 10)πPAINT (en, env + 1)ππemover = INT(RND * 100) + 1 'move the enemyπ' ^^^ This number determines how often the enemyπ'changes directions.πIF emover = 1 AND emove <> 2 THEN emove = 2πIF emover = 2 AND emove <> 1 THEN emove = 1πIF emover = 3 AND emovev <> 1 THEN emovev = 1πIF emover = 4 AND emovev <> 2 THEN emovev = 2πIF en = 5 THEN emove = 1πIF en > 315 THEN emove = 2πIF env = 2 THEN emovev = 1πIF env = 179 OR env > 179 THEN emovev = 2πIF emove = 1 THEN en = en + 1πIF emove = 2 THEN en = en - 1πIF emovev = 1 THEN env = env + 1πIF emovev = 2 THEN env = env - 1πIF en < b1 AND en > b2 AND env + 30 > avt AND env < avt THENπLINE (en, env + 10)-(en, avt + 10), 14ππshipst = 2πππPLAY "<<<c"ππgob = TIMERπgooober = gob + 1πDO WHILE gooober > gobπgob = TIMERπLOOPππCOLOR 0πLINE (en1 - 1, env - 1)-(en2 + 1, env + 11), , BFπCOLOR 15πen = 5πenv = 10πEND IFπIF shipst = 2 THENπshphlth = shphlth - 10πCOLOR 0πLINE (b1 + 15, avt - 16)-(b2 - 15, avb + 16), , BFπLINE (4, 185)-(66, 190), , BFπCOLOR 15πshipst = 1πEND IFππIF ens = 2 THEN 'Kill the enemyπ'FOR exspld = 1 TO 10π'CIRCLE (en, env), exspld, 8πSOUND 100, 2πSOUND 130, 2πSOUND 90, 2π'NEXT exspldππππCOLOR 0πLINE (en1 - 1, env - 1)-(en2 + 1, env + 11), , BFππFOR firex = 1 TO 200ππx = INT(RND * 15) + 1πxb = INT(RND * 15) + 1πyb = INT(RND * 15) + 1πy = INT(RND * 15) + 1πc = INT(RND * 10) + 1πIF c = 1 THEN f = 40πIF c = 2 THEN f = 116πIF c = 3 THEN f = 111πIF c = 4 THEN f = 44πIF c = 5 THEN f = 43πIF c = 6 THEN f = 42πIF c = 7 THEN f = 41πIF c = 8 THEN f = 184πIF c = 9 THEN f = 188πIF c = 10 THEN f = 184πx1 = en + x - xbπy1 = env + y - ybπPSET (x1, y1), fπNEXT firexπCLSπCOLOR 0πLINE (en1 - 55, env - 55)-(en2 + 55, env + 51), , BFπCOLOR 15ππtbon = tbon + timenπIF enkill = 5 THEN enspd = enspd + 5: enkill = 0πenkill = enkill + 1πtimens = INT(TIMER + 65 - enspd)πscr = scr + 100 * enspdπen = INT(RND * 315) + 5πens = 1ππencol = encol + 1πIF encol = 15 THEN encol = 1πCOLOR 0πLINE (en1 - 15, env - 15)-(en2 + 15, env + 21), , BFπCOLOR 15πtimeen = timen / 8πIF shphlth + timeen < 60 OR shphlth + timeen = 60 THEN shphlth = shphlth +πtimeenπCOLOR 15ππCOLOR 15πEND IFπLOOP WHILE INKEY$ <> CHR$(27) AND enspd < 115 AND timen > 0 AND shphlth >π0πCOLOR encolππCOLOR 15πPRINT "Score:"; scrπPRINT "Time bonus:"; tbonπPRINT "Final Score:"; scr + tbonπIF timen < 0 OR timen = 0 THENπCOLOR 14 'kill the earthπLINE (en, env + 16)-(1, 200)πLINE (en, env + 16)-(320, 200)πPAINT (en, env + 17)πLINE (b2, avt + 30)-(b1, avt - 30), , BFππgmovr:πLOCATE 13, 15πCOLOR 4ππPRINT "Game Over!"πSOUND 100, 2πSOUND 200, 2πSOUND 100, 2πshphlth = 1πEND IFπIF shphlth < 0 OR shphlth = 0 THENπFOR slip = 1 TO 30πCIRCLE (a, avt + 5), slip, 8πSOUND 100 + slip, 1πNEXT slipπGOSUB gmovrπEND IFπIF enspd = 115 THENπCOLOR 15πPRINT "Thank you for saving the earth, here is a medal for your bravery:"πLINE (140, 50)-(180, 50), 4πLINE (140, 50)-(140, 90), 4πLINE (180, 50)-(180, 90), 4πLINE (180, 90)-(160, 110), 4πLINE (140, 90)-(160, 110), 4πPAINT (160, 105), 4πCIRCLE (160, 140), 30, 44πPAINT (160, 140), 44πEND IFπINPUT "Would you like to play again?", agn$πIF agn$ = "y" OR agn$ = "Y" THEN GOSUB agnπSYSTEMππSUB earthπCOLOR 14πLINE (en, 21)-(1, 200)πLINE (en, 21)-(320, 200)πPAINT (en, 32)πLINE (a, 165)-(b1, 180) 'kill the shipπLINE (a, 165)-(b2, 180)πLINE (c, 178)-(d, 178)πLOCATE 13, 15πCOLOR 4πPRINT "Game Over!"ππEND SUBπJames McMurrin MATHEMATICAL WORMS OF XANTHE FidoNet QUIK_BAS Echo 11-25-92 (00:00) QB, QBasic, PDS 90 5908 WORM.BAS DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"WORM.ZIP",4^6:Z&=4158:?STRING$(50,177);πU"%up()%9%%%#-%Lj.AFHn1]<G.7%%$=%%%-%.%%&t%wrSgIfxl'<bAT]=7w(OB6hπU"ldaOCVf;Wc[AA]X*$-)AVn%ME9j9ltBM22&;NjPBjBtBfwXftFEp,4/#%L4,#9KπU"fO*92CNL%\L%35tPjeo:;1$3*_ZZQt6LTTt>)37t.;m<$[M2d-db?cQXENTf>L'πU"&0hdL_STcK2fq_l(50S;5rAf^[?0^m3W7-HepXg;vP9/S^9L^UR0w]RtcD>B%$wπU"?d>Z.n;Md_ZajsLq/1R,IElT.vudOy?O?Zd^0j$r>IlBd'5<uotmgcDf1gtuXY<πU"11=>cBH1o?Ub*&/**s4D4dHeP.wqqdqoiE5PmVMP04>H$$xL*LHT>?hV_<-ip&IπU"o^?s_\/mcSggPul.&6I?'rLd/oaa]\lS?7^mP7o8l2_U9sALp'L+<G5lxSgQgliπU"T*SLmVhoHH,R<AP73+q#P\=vlRV1r7rTF<X+b\1r7mFPCP)S_[tf6PcnF/:P;I.πU"8(hVw1#IpF47F,H$ijnl5Wm$Wnc9HQ^(^sf_SaWG_.K:kfb.5,X-h35V+I$G(XKπU"Z2N-Oj-Rd7>V$jbhsP1$J])U;U*Y^je(DjgY(=3+Ova.xm_A(.P=nX[YZr4lFUiπU"pC$?8e?u#Cb4,6?ON]wVqVw/f;F+i$Ll3kO#],:#1)$;'Sfgc>5L:3mnnIPigOYπU"t[1aRFQ+>jAJaT>-feWXWN%NVsEf^1,A[6Hn=4]#w]mTekw.Msc0&rQL.rm%AqCπU"<$Ne*9gJ.nAbX<*n]p:R,:H($>B5$9R3H[%o4:a/;tF4KP[a.ojA=j;EG/v4_92πU"/3+]HEk3?4'>7\>J#UIE)\[Y<eo/)1X?A62of2)2=ePq7Y$5W('2kGV*/\5xHkxπU"3_x___?h4vNLugOakhHCnCaXHd/tL%O\cCmh37^WPE[B::4D&I1I0Qj\'3a92i]πU"a/?6H)C=[#Eh'7VG^Z')f%DSu8A5>d/.J8KhU>4W('?Y(Q=R?s&CkmVC[8<WM3cπU"5HT,fO7nSdv,%*s5V9B'-c.,J/MZ\EA82jj\a-[aepprUa5h_xFC=WM\=d_oS;iπU"9:]DV'q2#&eP^/+M\F4(U;>Ok\[S\KC:n7*V7O]OhBBa/m%atItt$\>6Z'w9XONπU");YFGVlCZF:E8VD_b6\]=lfbD9+nR:\)T3EVDE7$=4nwEiQ>\S]Ag.B7AX0G/XuπU"F05MR1dogwnQZi6O+j1FM#S_2CFGaqoa.32Wzqq\wEA;52IlIV1F*c[;8ib^Y=5πU"_5rTS8m0B6[SG,KK&X3nR7h&jd'3<8OmF-$9dlXhUr+i9SwLY(NMS.yK;l7JU*9πU"0U>ijp/Ya<Wq\.w&rCA6(A2j?TNC42&H1A1Sjn5%Wg7&M,KeFfRN8?k<FE['Pt9πU"'?jJc-BJkr;T0]p;Is=C5$eC+G[Dj6B\o%Cfh()hhS*U);Ok_gS$I()oO^[gU,?πU"sBar6hXr$ag'QmZ#nk?D^e-(Jt=1ewd++s$+kIYc^YMP3,QTaO;NSvPmdw9.8)xπU"eppYz^K+M$$8JoH#'$Oj)C#[MrO&gY<-P.cFAg[gm2_[>:%GL]YRW5ycup2uk]NπU"?:sO^:Od^Cc9<#c[F<t-iSVRT^J5#4H[8sW00z1I1G/Yh]H*4*dr><vs,w7n*tfπU";zUJ)%vQ,n_yLtd16ecFM#/5mxF?RIi4uqPOhAn\Ys\#=KU(YP2Rq*Etwj+e.ZqπU">*8x<WOf0Sti3:o4jdOW:;#AdItHSDvPE%.s3[_&y=2GfADPArCGI*nFP4ogfP2πU"rK&>%s(-+t,CsfrVL3n%vC&G-pU=:R\)GE/*[fIDd<<?_B2lRrp=3D;_bBp5,/[πU",$W;(J38P.HT6'FkE7?-*$gYXJKj?=i(Bp+C8LPJnm4(m=vLHB[aq;Iw=MkW1=MπU"[I\qQ+)B*S_=0,7-x\9B9,-hXF<Go**EO7'sx-,(\7oN$qU&&l4wcT0oNvBRd$CπU"=&tEv67TKQlyWN;I7nBvQc1i1[6oAKNYGc<i[#e(89T'ogRcE=zEI&)N;p+vPifπU";(V:-DpTr2>^'sdIJ7M<&0IE9<(U$#bJ9j$O#NpGza;m;oUlG.B3(Y+;RKu_>.qπU"AKC,p[bB.Rl0vWudT.ojp=9b)A$si2uM2up5trHr)I-t*^26<bpCS['eQl#<1gcπU"q1P8p'WsDG5mUo[11+UX4;deq3;J?fI^UWC7=t&2oXRj4BW#u>=.P_G1](ef:R&πU"5LOr#WXcem=bY/^8y_GdBg^V>,H'n,sb0aX$jk]o;G-Rt(1t(^LtGoGD$8s-P^*πU"%CYG8-H0>i7lE1;i4([Vp1q[TC.WNV);d)AEZXfx;VEYq0+[*_:eCARO+0;dQ\CπU"9dL*u=Pi%d[=gs&m:\m-V(Z=J;-,;/MbUCF]I?4VPG#470vEq?):m9JK$=;Yb0nπU"&)&)<wOK(;vVv'b$56<S?PX?1v?3HNwt$nJ)=?EjS-EjK1/<onL]15PP7sAiH^dπU"t<>btTZW/<_qz::R]3-b)HG?L<m[cIjSI\#.i'KM_+<[G'xNqY$*SAc8?=Vni2+πU"TpK#?BKh342:nTS^1wDbB((F7YE,r1bqRRFs]QR-&4z.VJ^8e_u?Z\/u7g3);4kπU"oQC:pB'Nb9C-'41Hi7VsIPGSI(22#FxMQ^jsUOxQyvFmlU_[6I4']-M(LNBDufoπU"hD)bS#wp)^toB[r*4h84zRrMjwMCu$e4ZGHe9lV9F3?#\-df18]ptnhF-o[1m4zπU"[Px$+hKj-EAKh2\si]b<B]sD2tNs'juq=I(?qf&3g4y$s=Mhpg\VYdvl42I&1G.πU";>l).J,mi;\1%m,JVeco0.;V?yK'u4xT<4h&UGY&eErg2s9C%N,7)0MLlA&L/TaπU"O#LrBS722s\CPK[aOZCJ&CyALWH[nl_]LGI0H>IOaXhjKRa(bQgR$n'IzsLf<lbπU"[fd/*(CAx&3T-M(ROS1oP;+Ru+/XPF7(<=mRU-tF\fHIG6*kyJzW5rSM4\LiXelπU"FG+UOqMZutqS6G7+x&B5$\k*S$Z8g8Qm6CqSy\($H(>krS(P't)b[i?e7r][h[gπU"82CyhL.D/DiP6?;>$n-y6F'J>CMAm+mZip<S&4q.^e#rxt0bLIA'xDup%()9%%%πU"%-%)qiAFp2XAN'6'%%'n)%%%.%%%&&twr%VSfs%xzyr,>T_595,ATiI4BC[J5QTπU"t8K_]/f]/CP-\o#&j)_vZKS[Z#i?I4sfx74Vs40URJmug=>GeO6B$b[rBvxKaZ8πU"tkHBVQ:$P1.Xg<CvT?Lv[dqG*vq0w/zl_G.aL+U&:njc\:W<7X>?Z=[^4rrk]goπU"uQB4c^<\;R:e8Db\I#T#_U#GYfSLJFRp-dTJ-CR0UotxtGa%KY*Yb-V8^oY)nV6πU"6L_,p<bd?OB](*TTI=?b-X>f[;iQ+i?uaZKJ<-xar_JQld+wq,p'R^aG/aC.PL<πU"G/:.:&N6:YGS(W6CYIWU$C-L3oC'$dEfc\uF+;2,^W+6]Ww/2kfED/S*QI986jmπU"^,Plq*/BC/C)Zjv:?MU=5Z-9iSshCu=F8eCnltZ<>CJ5'mvLr&*Qybk.vz&MKL^πU"w\U[eH50oiP=#rzHqX(Ng[]n9)e-%rDpSnKr&IoWj?bkL=$-#cLj$s:.d7:a%MBπU"EQ08#SA1sePtGK&'YMd/j&s4go;vm':zcsmPZ)E*1blZ0oY.=(c6[:\*3oc7/k=πU"g&%NaOEdKipHp)LTD&tp[7Zg7uIcmEl+'3/9PtMfm;_6;DLZaXLu&Cs(qq$5RmYπU"O+#6r;itBMNa<%'rHNaF_/AB=[Ge'EU<9i*Sl-2-d,H0fN+u)]Dljf6GO?(]esKπU".B<$.M']W+)jo2=mrIR.(-j/)4noQ\B)j43i%yQ&<J8Un<>tFrL;;3jJ]caS?9$πU"#;aIUT[TMmYJR(1aWL9?^EBqx#8A8NdMF]oqRD]2U&eo[rR)SIHO1Q((YUV1si[πU"tQ>Z])7APM=7Q29HAaw=g2^OK]wkAgN5F,P(t1Xb_[>Yd8,E:CFa03#e##[Zw.bπU"H85iUZ)AWRR>*51E$-[Fr8RZ^T*Osbd't2up%()9%%%%-%)siAFF[lio'T'%%%=πU"*%%%.%%%&&twr%WSfs[xzy:,=T]995<a<BaW^<#'=k;;v8,bD8,ZA-P*(pXjOIXπU"N*7Zw(iInOkUxMXJrQtJh_/blQ_Fjpd=:F0#ryqNEIB\^tYT(,1nbv.hm1ILJ:VπU"^fMG(>msW%8\_nGjDJSrr1skH]dY;O5sq#]fsULq;LBu5:<eeI'(T9YRK/bIzdAπU"xr//2:)ky,,<n.)PRzJBEC$:Dkb3J)4lDHN(sr<jPZJ?go16%5e->Y(FLJa1?0NπU"jW>vMVP,fT1o9=P-G??n)Yxxi?:LHm5:L#7>4xxm6F,nK0&;nJU^?vofCOk)X]lπU"KOglLP%NpJ-Hi<$rK,.M2NWVwtpp*DF;pXg]97EF8ibD$c7lPu3<C)gvTh.A:nnπU"T)Zfpmg+Ls\iy,1LxtC[I[brJ$(2\Gbu.]-X)<W'2cAvo/%;sl<>f-(=h29lPA1πU"S53KR^Hm-7PF3sNCL&EM=lT>($J]Dft3tWLqrL^(4GUnbN_+Z$ct-PdQfh[fG2=πU"i7?KZrd$1Nr\1nRq]pGNHlgj<Ec:oP9rjl:H)a>)4fg]OL[Gc3;U#hH]gMEVA[>πU"mhgvxkQ%w/tWMr9Mjy4.+)SOXRcFRXgrrniCA7Sj&_54^3iu;D9QLEb(N3$\;h-πU"ttFOCC1::f8PbUH6?q>wL8R)6BbA*9jsoM_Nodl9:IhB;f2#*8zC=C2TB_'qBjGπU"G(NL]i[mr15>+K8?$B\;Nb1d6k;j6/X]l;I<ipf>ZDwMAf3wbF>2]o1k>)&]L3nπU"S%-hE#ji<Uj'aZ.IGsTbn>8d#e,k\6\<tvsFiRL[)+;KNp#]PY5TB*8?d$%^ivXπU"e2n[.\y*p0$'u75>+f5^A?b,pQRT($?&<<CT&efP^K25Pjk0lOsQzVC^HZ<Am\nπU"egF-<jYF+^R>h^jKc#lWWgS%^ZMQI[n2azzPFO]$<WCfS<Zlj<N%up&'%9%9%%%πU"%-%(LjAFAHn]<&G.%%'$=%%%-%%%%%%%%%&%E%%%%%%.%%&t%wrSg%fxup%&'9%πU"%9%%%I-%qi#AF2X?AN6'7%%n)%%%.%%%%%%%%%&%%E%%%&m.%%&&twr%VSfs%xuπU"p&%'9%9%%%%-1%siA7F[li,oT'%%%=*%%%.%%%%%%%%%&%E#%%%Q#1%%&%twrW%πU"Sfsx%up*+%%%%%%(%(%&s%%%&S4%%%%%πEND SUBπCLOSE:IF S=195AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπRichard Hilsden FEDERATION DEFENDER rhilsden@idirect.com 08-29-96 (10:17) QB, QBasic, PDS 1068 32378 FED-DEF.BAS 'Welcome To federation Defender This is Version 1.01π'1.0 Was Almost the same Exepet it was way to easy soπ'I made It alot harder (Still a bit too easy)π'This happends to be my first Game that I have madeπ'And I hope you think its good most of my friends sayπ'It's fine but the don't like the control Oh well.π'Ya there Are a few gliches And in the next verion Iπ'should have them all fixed. You may say My code Isπ'veary messy Well that's because I've only been programingπ'for 2 Months. I hope you enjoy itππDECLARE SUB LostGame ()πDECLARE SUB BeatGame ()πDECLARE SUB Center0 (Row!, Text$, c!)πDECLARE SUB TheStory ()πDECLARE SUB Center (Row, Text$, c)πDECLARE SUB Game1 ()πDECLARE SUB Pacman ()πDECLARE SUB BigD ()πDECLARE SUB Bye ()πDECLARE SUB DrawBye ()πDIM dot(1000)πCLEAR , , 20005ππSCREEN 12πGameEnd% = 0πpacx = 320πpacy = 225πs% = 0πCONST ArraySize = 242, NumGraphics = 21πCONST Delay = 700πCONST True = -1, False = NOT TrueπDIM Graphic(0 TO ArraySize * NumGraphics)πBigDπCLEAR , , 20005πPacmanπCLEAR , , 20005ππCount% = 2πSCREEN 13π2πCLEAR , , 20005πON PLAY(1) GOSUB MuchMusicπdoth% = 75πCLSπCOLOR 15πCIRCLE (210, 120), 4, 7 'dotπPAINT (210, 120), 4, 7πGET (220, 145)-(200, 95), dotπCLSπ3πππLINE (62, 10)-(230, 70), 0, BFπLINE (62, 10)-(230, 70), 12, BπLINE (61, 9)-(231, 71), 4, BπLINE (60, 8)-(232, 72), 7, BπCOLOR 15: LOCATE 5, 10: PRINT "F": PLAY "l30n0"πCOLOR 2: LOCATE 5, 10: PRINT "F": COLOR 15: LOCATE 5, 11: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 11: PRINT "e": COLOR 15: LOCATE 5, 12: PRINT "d": PLAY "l30n0"πCOLOR 2: LOCATE 5, 12: PRINT "d": COLOR 15: LOCATE 5, 13: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 13: PRINT "e": COLOR 15: LOCATE 5, 14: PRINT "r": PLAY "l30n0"πCOLOR 2: LOCATE 5, 14: PRINT "r": COLOR 15: LOCATE 5, 15: PRINT "a": LOCATE 17, 15: PRINT "E": LOCATE 15, 15: PRINT "S": LOCATE 13, 15: PRINT "P": PLAY "l30n0"πCOLOR 2: LOCATE 5, 15: PRINT "a": LOCATE 17, 15: PRINT "E": LOCATE 15, 15: PRINT "S": LOCATE 13, 15: PRINT "P": COLOR 15: LOCATE 5, 16: PRINT "t": LOCATE 17, 16: PRINT "x": LOCATE 15, 16: PRINT "t": LOCATE 13, 16: PRINT "l": PLAY "l30n0"πCOLOR 2: LOCATE 5, 16: PRINT "t": LOCATE 17, 16: PRINT "x": LOCATE 15, 16: PRINT "t": LOCATE 13, 16: PRINT "l": COLOR 15: LOCATE 5, 17: PRINT "i": LOCATE 17, 17: PRINT "i": LOCATE 15, 17: PRINT "o": LOCATE 13, 17: PRINT "a": PLAY "l30n0"πCOLOR 2: LOCATE 5, 17: PRINT "i": LOCATE 17, 17: PRINT "i": LOCATE 15, 17: PRINT "o": LOCATE 13, 17: PRINT "a": COLOR 15: LOCATE 5, 18: PRINT "o": LOCATE 17, 18: PRINT "t": LOCATE 15, 18: PRINT "r": LOCATE 13, 18: PRINT "y": PLAY "l30n0"πCOLOR 2: LOCATE 5, 18: PRINT "o": LOCATE 17, 18: PRINT "t": LOCATE 15, 18: PRINT "r": LOCATE 13, 18: PRINT "y": COLOR 15: LOCATE 5, 19: PRINT "n": LOCATE 15, 19: PRINT "y": PLAY "l30n0"πCOLOR 2: LOCATE 5, 19: PRINT "n": LOCATE 15, 19: PRINT "y": PLAY "l30n0"πCOLOR 15: LOCATE 5, 21: PRINT "D": PLAY "L30n0"πCOLOR 2: LOCATE 5, 21: PRINT "D": COLOR 15: LOCATE 5, 22: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 22: PRINT "e": COLOR 15: LOCATE 5, 23: PRINT "f": PLAY "l30n0"πCOLOR 2: LOCATE 5, 23: PRINT "f": COLOR 15: LOCATE 5, 24: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 24: PRINT "e": COLOR 15: LOCATE 5, 25: PRINT "n": PLAY "l30n0"πCOLOR 2: LOCATE 5, 25: PRINT "n": COLOR 15: LOCATE 5, 26: PRINT "d": PLAY "l30n0"πCOLOR 2: LOCATE 5, 26: PRINT "d": COLOR 15: LOCATE 5, 27: PRINT "e": PLAY "l30n0"πCOLOR 2: LOCATE 5, 27: PRINT "e": COLOR 15: LOCATE 5, 28: PRINT "r": PLAY "l30n0"πCOLOR 2: LOCATE 5, 28: PRINT "r"πPUT (90, doth%), dot, PSETπPLAY ONπMBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πPLAY "MB X" + VARPTR$(MBuff$)ππ1πhe:πDOπSELECT CASE INKEY$πCASE IS = CHR$(0) + "H": GOSUB upπCASE IS = CHR$(0) + "P": GOSUB downπCASE IS = CHR$(13): GOSUB reternπEND SELECTπGOTO 1πdown:πFOR repeat = 1 TO 3πIF doth% < 105 THENπdoth% = doth% + 5πEND IFπNEXT repeatπPUT (90, doth%), dot, PSETπRETURNπup:πFOR repeat = 1 TO 3πIF doth% > 75 THENπdoth% = doth% - 5π'v% = v% - 1πEND IFπNEXTπPUT (90, doth%), dot, PSETπGOTO 1πLOOP UNTIL INKEY$ = CHR$(27)πretern:πIF doth% = 75 THEN CLEAR , , 20005: CALL Game1: CLEAR , , 20005: GOTO 2πIF doth% = 90 THEN CLEAR , , 20005: CALL TheStory: CLEAR , , 20005: GOTO 2πIF doth% = 105 THENπEND IFπSCREEN 12π'ByeπSYSTEMπMuchMusic:πCount% = Count% + 1πSELECT CASE Count%πCASE 0: MBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πCASE 1: MBuff$ = "P16L16<GGGL2>CGP32L16FEDL2>C<GP16L16FEDL2>C<GP16L16A+"πCASE 2: MBuff$ = "AA+L1GL2G.L8<G.L16GL4A.L8A>FEDCL16CDEDP16L8"πCASE 3: MBuff$ = "<AL4BL8G.L16G"πCASE 4: MBuff$ = "L4A.L8A>FEDCGP8L4D.P8L8<G.L16GL4A.L8A>FEDCL16"πCASE 5: MBuff$ = "CDEDP16L8<A"πCASE 6: MBuff$ = "L4BP16L8>G.L16GL8>C.L16<A+L8G+.L16GL8F.L16D+L8D.L16CL1G"πCASE 7: MBuff$ = "L2G.P16L16GGGL8>CP8L16<CCCL2C.": Count% = -1πEND SELECTπPLAY "MB X" + VARPTR$(MBuff$)πRETURNππSUB BeatGameπDIM Ship(900)πON PLAY(1) GOSUB MuchMusicπPLAY ONπMBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πPLAY "MB X" + VARPTR$(MBuff$)πg% = 400πx% = 288πStarNum% = 300πLNum% = 1πDIM StarX(StarNum%), StarY(StarNum%), Layer(LNum%)πLINE (10, 10)-(10, 20), 3π LINE (10, 18)-(20, 15), 3π LINE (25, 20)-(25, 10), 3π LINE (25, 18)-(19, 15), 3π LINE (18, 5)-(18, 15), 2πGET (31, 28)-(2, 1), ShipπCLSπFOR l = 1 TO LNum%πIF l = 1 THEN Layer(l) = 3πIF l = 2 THEN Layer(l) = 4πDO: k$ = "R": LOOP UNTIL k$ = "L" OR k$ = "R"πIF k$ = "L" THEN Layer(l) = -Layer(l)πPRINTπNEXT lπFOR I% = 1 TO StarNum%πStarX(I%) = (RND * 619) + 1πStarY(I%) = (RND * 599) + 1πNEXT I%ππDOπFOR I% = 1 TO StarNum%πPSET (StarX(I%), StarY(I%)), 0πIF I% > (StarNum% / LNum%) * CL THEN CL = CL + 1πStarX(I%) = StarX(I%) + Layer(CL)πIF StarX(I%) < 1 THEN StarX(I%) = 619: StarY(I%) = RND * 619πIF StarX(I%) > 599 THEN StarX(I%) = 1: StarY(I%) = RND * 599πc% = (CL * 4) + 19πPSET (StarX(I%), StarY(I%)), c%πNEXT I%πIF g% > 20 THENπFOR jkjkj% = 1 TO 3πg% = g% - 2.5πPUT (x%, g%), Ship, PSETπNEXT jkjkj%πEND IFπCOLOR 15: LOCATE 8, 10πPRINT "Thanks to you, The Nebulatic Army has been defeated. The Vanderbelt"πPRINT " king gave you the medal of bravery for your boldness in the"πPRINT " destruction of The Nebulatic race. The galaxy is safe... "πPRINT ""πPRINT " -- At least For Now --"πLOOP WHILE INKEY$ = ""πIF g% > 20 THENπFOR jkjkj% = 1 TO 3πg% = g% - 2.5πPUT (x%, g%), Ship, PSETπNEXT jkjkj%πEND IFππEND SUBππSUB BigDπCLSπSCREEN 12πVIEW (0, 0)-(639, 479)πWINDOW (0, 0)-(200, 200)πDRAW "bl155r20d8l10g5d2r15d20g5l20u8r10e5u2l15u20e5br40"πPLAY "l4n0"πPLAY "l4n0"πDRAW "r15f5d30g5l15h5u30e5bf5bd1r5f2d24g2l5h2u24e2bu1bh5br35"πPLAY "l4n0"πDRAW "d40r10u10r10u10l10u10r15u10l25br40"πPLAY "l4n0"πDRAW "d10r8d30r9u30r8u10l25br40"πPLAY "l4n0"πDRAW "d40r5e8f8r5u40l10d10l5u10l10br40"πPLAY "l4n0"πDRAW "d40r10u10r5d10r10u40l25br10bd10d5r5u5l5bu10br30"πPLAY "l4n0"πDRAW "d40r10u10f10r5u5h15r10e5u10h5l20bf10bu5r5f3d3g3l5u9bd5bh10br40"πPLAY "l4n0"πDRAW "d40r25u10l15u5r10u10l10u5r15u10l25"πFOR I% = 0 TO 63πPALETTE 12, I%πLOCATE 6, 21πCOLOR 12πPRINT TAB(19); "╔════════╗ ╔════════╗ ╔════════╗ ╔╗ ╔╗"πPRINT TAB(19); "║╔═══════╝ ║╔══════╗║ ║╔══════╗║ ║║ ║║"πPRINT TAB(19); "║║ ║║ ║║ ║║ ║║ ║║ ║║"πPRINT TAB(19); "║╚═══╗ ║║ ║║ ║╚══════╝║ ║╚══════╝║"πPRINT TAB(19); "╚═══╗╚═══╗ ║║ ║║ ║ ╔══════╝ ║╔══════╗║"πPRINT TAB(19); " ╚═══╗║ ║║ ║║ ║ ╚══╗ ║║ ║║"πPRINT TAB(19); "╔═══════╝║ ║╚══════╝║ ║╔══╗╚═══╗ ║║ ║║"πPRINT TAB(19); "╚════════╝ ╚════════╝ ╚╝ ╚════╝ ╚╝ ╚╝"πNEXT I%πPLAY "l64o6bagfedco5bagfedco4bagfedco3bagfedco2bagfedco1bagfedco0bagfedcl1n0"πCLSπEND SUBππSUB ByeπVIEW (0, 0)-(639, 479)πDOπIF flip% = 0 THENπflip% = 1πj% = 64πFOR I% = 0 TO 63 STEP 2πj% = j% - 2πPALETTE 6, j%πPALETTE 7, I%πLINE (0, 0)-(639, 479), 6, BFπCOLOR 7πDrawByeπNEXT I%πELSEπflip% = 0πj% = 64πFOR I% = 0 TO 63 STEP 2πj% = j% - 2πPALETTE 7, j%πPALETTE 6, I%πLINE (0, 0)-(639, 479), 6, BFπCOLOR 7πDrawByeπNEXT I%πEND IFπLOOP WHILE INKEY$ = ""πEND SUBππSUB Center (Row, Text$, c)πCOLOR cπLOCATE Row, 20 - (LEN(Text$) / 2)πPRINT Text$πCOLOR 15πEND SUBππSUB Center0 (Row, Text$, c)πCOLOR cπLOCATE Row, 40 - (LEN(Text$) / 2)πPRINT Text$πCOLOR 15πEND SUBππSUB DrawByeπLOCATE 15, 2: PRINT "████████████████": LOCATE 15, 33: PRINT "████████": LOCATE 15, 50: PRINT "████████████████"πLOCATE 14, 2: PRINT "████": LOCATE 14, 17: PRINT "███": LOCATE 14, 32: PRINT "████": LOCATE 14, 38: PRINT "████": LOCATE 14, 50: PRINT "████"πLOCATE 16, 2: PRINT "████████████████": LOCATE 16, 34: PRINT "██████": LOCATE 16, 50: PRINT "████████████████"πLOCATE 13, 2: PRINT "████": LOCATE 13, 17: PRINT "███████": LOCATE 13, 31: PRINT "████": LOCATE 13, 39: PRINT "████": LOCATE 13, 50: PRINT "████"πLOCATE 17, 2: PRINT "████": LOCATE 17, 17: PRINT "███": LOCATE 17, 35: PRINT "████": LOCATE 17, 50: PRINT "████"πLOCATE 12, 2: PRINT "████": LOCATE 12, 21: PRINT "███": LOCATE 12, 30: PRINT "████": LOCATE 12, 40: PRINT "████": LOCATE 12, 50: PRINT "████"πLOCATE 18, 2: PRINT "████": LOCATE 18, 17: PRINT "███████": LOCATE 18, 35: PRINT "████": LOCATE 18, 50: PRINT "████"πLOCATE 11, 2: PRINT "████": LOCATE 11, 21: PRINT "███": LOCATE 11, 29: PRINT "████": LOCATE 11, 41: PRINT "████": LOCATE 11, 50: PRINT "████"πLOCATE 19, 2: PRINT "████": LOCATE 19, 20: PRINT "████": LOCATE 19, 35: PRINT "████": LOCATE 19, 50: PRINT "████"πLOCATE 10, 2: PRINT "████": LOCATE 10, 18: PRINT "██████": LOCATE 10, 28: PRINT "████": LOCATE 10, 42: PRINT "████": LOCATE 10, 50: PRINT "████"πLOCATE 20, 2: PRINT "████": LOCATE 20, 20: PRINT "████": LOCATE 20, 35: PRINT "████": LOCATE 20, 50: PRINT "████"πLOCATE 9, 2: PRINT "███████████████████": LOCATE 9, 27: PRINT "████": LOCATE 9, 43: PRINT "████": LOCATE 9, 50: PRINT "██████████████████████"πLOCATE 21, 2: PRINT "████": LOCATE 21, 18: PRINT "██████": LOCATE 21, 35: PRINT "████": LOCATE 21, 50: PRINT "████"πLOCATE 8, 2: PRINT "████████████████": LOCATE 8, 26: PRINT "████": LOCATE 8, 44: PRINT "████": LOCATE 8, 50: PRINT "██████████████████████"πLOCATE 22, 2: PRINT "███████████████████": LOCATE 22, 35: PRINT "████": LOCATE 22, 50: PRINT "█████████████████████"πLOCATE 23, 2: PRINT "███████████████": LOCATE 23, 35: PRINT "████": LOCATE 23, 50: PRINT "█████████████████████"πEND SUBππSUB Game1πDIM Ship(900)πDIM Enemy(900)πDIM shot(800)πDIM Eshot(800)πRANDOMIZE TIMERπleveltoggle% = 1πlife% = 2πraguExtraChunky:π'Varable Settingsπetoggle% = 2πPeashooterFX$ = "l64o1cdefgabagfedc"πDrunkFX$ = "l64o1abababababo0cdcdcdcdcd"πHomingFX$ = "l64o1abo0cdo1abo0cdo1abo0cdo1abo0cdo1abo0cdo1ab"πLaserFX$ = "l64 o6bgec o5bgec o2be o0gc"πShotFX$ = "l64 o5ec o6bgec o5bgec o2bgec o0bgec"πex% = 30 'Enemy shot Left & rightπey% = 60 'Enemyshot up & downπg% = 312 'Up & Downπx% = 288 'Left & rightπrc% = 0πv% = 1πl% = 15 'Enemy up & downπr% = 20 'Enemy left & rightπd% = 30 'Shot up & downπf% = 60 'Shot left & rightπpee% = 0πts% = 800πMasterLeveltoggle% = 1πhit% = 0πEnemyLife% = 3πhitshot = 0πdie% = 0π'ewt% = RND * 3 + 1 'Random EWTπIF leveltoggle% = 1 THENπewt% = 3 'Enemy Weapon Type:πELSEIF leveltoggle% = 2 THENπewt% = 2πELSEIF leveltoggle% = 3 OR leveltoggle% = 4 THENπewt% = 1πELSEIF leveltoggle% > 4 THENπewt% = 4πEnemyLife% = 4πELSEπewt% = 4πEND IFπ '1 = Class I laserπ '2 = Peashooterπ '3 = RS-1 "Drunk" torpedoπ '4 = RS-2 "Homing torpedoπSCREEN 12π 'Enemy Shot Code:πPALETTE 14, 63πIF ewt% = 1 THENπLINE (2, 10)-(2, 45), 4 'LaserπGET (1, 1)-(3, 50), Eshot 'LaserπELSEIF Ewt2% = 1 THENπLINE (2, 10)-(2, 45), 4πGET (1, 1)-(3, 50), EshotπELSEIF ewt% = 3 OR ewt% = 4 OR Ewt2% = 1 THENπCIRCLE (210, 120), 3, 7 'TorpedoesπELSEIF ewt% = 2 THENπCIRCLE (210, 120), 2, 7 'PeashooterπPAINT (210, 120), 2, 7 'PeashooterπEND IFπIF ewt% = 4 OR Ewt2% = 1 THENπPAINT (210, 120), 3, 7 'Homing torpedoπELSEIF ewt% = 3 THENπPAINT (210, 120), 5, 7 'Drunk torpedoπELSEπEND IFπIF ewt% = 2 OR ewt% = 3 OR ewt% = 4 OR Ewt2% = 1 THENπGET (220, 130)-(200, 110), Eshot 'Everything but laserπELSEπEND IFπ'PUT (30, 50), Eshot, PSETπCLSππLINE (10, 10)-(10, 20), 3 'This draws the shipπLINE (10, 18)-(20, 15), 3πLINE (25, 20)-(25, 10), 3πLINE (25, 18)-(19, 15), 3πLINE (18, 5)-(18, 15), 2πGET (31, 28)-(2, 1), ShipππPALETTE 14, 63 'This draws the enemyπCIRCLE (545, 120), 8, 7πPAINT (545, 120), 14, 7πGET (555, 130)-(535, 80), EnemyππSCREEN 12πLINE (2, 5)-(2, 40), 3 'This draws the shotπGET (1, 70)-(2, 1), shotπPUT (30, 50), shot, PSETπCLSππLINE (15, 432)-(600, 15), 0, BFπLINE (11, 433)-(517, 11), 7, BππPUT (x%, g%), Ship, PSETππ7πIF k% = 2 THENπNew% = f% - 40πNew1% = 20πLINE (New%, New1%)-STEP(90, 90), 0, BFπPUT (x%, g%), Ship, PSETπk% = 0πEND IFπIF die% = 1 THENπdie% = 0πNew% = 520πNew1% = 100πLINE (New%, New1%)-STEP(50, 50), 0, BFπPUT (x%, g%), Ship, PSETπEND IFπIF Ek% = 1 THENπEnew% = ex%πEnew1% = ey%πLINE (Enew%, Enew1%)-STEP(30, 50), 0, BF: ex% = 30: ey% = 60: Ek% = 0πPUT (x%, g%), Ship, PSETπEND IFπCOLOR 15: LOCATE 2, 67: PRINT " INFO BAR" 'The Change I made for the Info barπLOCATE 3, 66: PRINT "--------------"πLINE (541, 76)-(611, 90), 14, BFπLOCATE 7, 67: PRINT " Enemy Life"πLOCATE 10, 67: PRINT " Lives:"; life%πDOππSELECT CASE INKEY$πCASE IS = CHR$(0) + "H": GOSUB RaiseπCASE IS = CHR$(0) + "P": GOSUB LowerπCASE IS = CHR$(0) + "K": GOSUB LeftπCASE IS = CHR$(0) + "M": GOSUB RightπCASE IS = " "πIF NOT k% = 1 THEN GOSUB fireπCASE IS = CHR$(27): GOSUB endingπEND SELECTππIF d% < 20 THEN d% = g% - 5: k% = 2πIF k% = 2 THEN d% = g% - 5πIF k% = 1 THEN GOTO 56πGOTO 23ππRaise: π IF g% > 90 THENπ FOR l = 1 TO 2π g% = g% - 4π PUT (x%, g%), Ship, PSETπ NEXTπ END IFπ PUT (x%, g%), Ship, PSETπ RETURNπGOTO 23ππLower:π IF g% < 370 THENπ FOR l = 1 TO 2π g% = g% + 4π PUT (x%, g%), Ship, PSETπ NEXTπ END IFπ PUT (x%, g%), Ship, PSETπ RETURNπGOTO 23ππRight:π IF x% < 480 THENπ FOR l = 1 TO 2π x% = x% + 4π PUT (x%, g%), Ship, PSETπ NEXTπ END IFπ PUT (x%, g%), Ship, PSETπ RETURNπGOTO 23ππLeft:π IF x% > 20 THENπ FOR l = 1 TO 2π x% = x% - 4π PUT (x%, g%), Ship, PSETπ NEXTπ END IFπ PUT (x%, g%), Ship, PSETπ RETURNπGOTO 23ππovershot:πRETURNππfire:π PLAY "MB X" + VARPTR$(ShotFX$)π IF barreltoggle% = 0 THENπ barreltoggle% = 1π ELSEπ barreltoggle% = 0π END IFπ IF fire% = 6 THEN GOSUB overshot:π IF k% = 1 THEN GOTO 56π fire% = fire% + 1π d% = g% - 5π f% = x%π IF barreltoggle% = 0 THEN f% = f% + 26π IF barreltoggle% = 1 THEN f% = f% + 4π k% = 1π56π IF d% < 20 THEN k% = 2: PRINT shot: GOTO 7π d% = d% - 8π PUT (f%, d%), shot, PSETπ h% = f%π hight% = d%π hi% = r% + 38ππ IF h% > hi% - 37 AND h% < hi% - 19 AND d% < 65 AND d% > 35 THENπ hit% = hit% + 1: hitshot% = 1: d% = g% - 5: die% = 1π END IFπ IF hit% = EnemyLife% THENπ GOSUB Ending2π END IFπ IF hit% = 2 AND hitshot% = 1 THENπ hitshot% = 0π k% = 2π FOR I% = 46 TO 30 STEP -1π PALETTE 14, I%π PLAY "l32n0"π FOR j% = 1 TO 30π die% = 0π New% = 520π New1% = 100π NEXT j%π NEXT I%π END IFπ IF hit% = 3 AND hitshot% = 1 THENπ hitshot% = 0π k% = 2π FOR I% = 30 TO 0 STEP -1π PALETTE 14, I%π PLAY "l32n0"π FOR j% = 1 TO 30π die% = 0π New% = 520π New1% = 100π NEXT j%π NEXT I%π END IFπ IF hit% = 1 AND hitshot% = 1 THENπ hitshot% = 0π k% = 2π FOR I% = 63 TO 46 STEP -1π PALETTE 14, I%π PLAY "l32n0"π FOR j% = 1 TO 30π die% = 0π New% = 520π New1% = 100π NEXT j%π NEXT I%π END IFπ GOSUB 23πLOOP UNTIL INKEY$ = CHR$(27)ππ23 'Enemy AIπ PUT (r%, l%), Enemy, PSETπIF v% = 1 THEN GOTO 76πIF v% = 2 THEN GOTO 67ππ76π IF r% > 20 OR r% < 480 THENπ r% = r% + 2π PUT (r%, l%), Enemy, PSETπ END IFπ IF r% = 480 THEN v% = 2π IF ewt% = 1 THENπ IF x% < r% - 6 AND x% > r% - 14 THEN Eshot% = 1 'Laserπ ELSEπ IF leveltoggle% < 5 THEN cool% = RND * 200 'Random, everything but laserπ IF leveltoggle% = 5 THEN cool% = RND * 100π IF cool% = 7 THEN Eshot% = 1 'Random, everything but laserπ 'cool% = cool% + 1 'Everything but laserπ 'IF cool% = 200 THEN Eshot% = 1 'Everything but laserπ END IFπ IF Eshot% = 1 THEN GOSUB Enemyshot 'EverythingπGOTO 7ππ67π IF r% > 20 THENπ r% = r% - 2π PUT (r%, l%), Enemy, PSETπ END IFπ IF r% = 24 THEN v% = 1π IF r% = 400 THEN v% = 2π IF ewt% = 1 THENπ IF x% < r% - 6 AND x% > r% - 14 THEN Eshot% = 1 'Laserπ ELSEπ cool% = RND * 200 'Random, everything but laserπ IF cool% = 7 THEN Eshot% = 1 'Random, everything but laserπ 'cool% = cool% + 1 'Everything but laserπ 'IF cool% < 200 THEN Eshot% = 0 'Everything but laserπ 'IF cool% = 200 THEN Eshot% = 1 'Everything but laserπ END IFπ IF Eshot% = 1 THEN GOSUB Enemyshot 'EverythingπGOTO 7ππending:πPRINT "Do You Want To Exit Y/N"πA$ = UCASE$(INPUT$(1))πIF A$ = "N" THEN GOTO 7πIF A$ = "Y" THEN GOTO 10 ELSE GOSUB endingππEnding2:πDOπrc% = rc% + 1πrr% = RND * 20 + r%πrl% = RND * 20 + l% + 30πPSET (rr%, rl%), 0πLOOP UNTIL rc% = 600πCLSπFOR I% = 1 TO 63πPALETTE 10, I%πLOCATE 10, 20πCOLOR 10πPRINT TAB(21); "╔═════════════════════════════════╗"πPRINT TAB(21); "║ ║"πPRINT TAB(21); "║ You have beaten level"; leveltoggle%; "!!! ║"πPRINT TAB(21); "║ ║"πPRINT TAB(21); "╚═════════════════════════════════╝"πNEXT I%πPLAY "l2n0"πKeyy$ = UCASE$(INPUT$(1))πFOR d% = 63 TO 1 STEP -1πPALETTE 10, d%πLOCATE 10, 20πCOLOR 10πPRINT TAB(21); "╔═════════════════════════════════╗"πPRINT TAB(21); "║ ║"πPRINT TAB(21); "║ You have beaten level"; leveltoggle%; "!!! ║ "πPRINT TAB(21); "║ ║"πPRINT TAB(21); "╚═════════════════════════════════╝"πNEXT d%πIF leveltoggle% = 7 THENπBeatGame: GOTO 10πELSE leveltoggle% = leveltoggle% + 1: GOTO raguExtraChunkyπEND IFπEnemyshot:πIF loser% = 4 THEN GOTO winnerπloser% = 4πIF ewt% = 1 THENπPLAY "MB X" + VARPTR$(LaserFX$) 'LaserπELSEIF ewt% = 2 THENπPLAY "MB X" + VARPTR$(PeashooterFX$) 'PeashooterπELSEIF ewt% = 3 THENπPLAY "MB X" + VARPTR$(DrunkFX$) 'Drunk torpedoπELSEIF ewt% = 4 THENπPLAY "MB X" + VARPTR$(HomingFX$) 'Homing missileπEND IFπex% = r%πIF ewt% = 2 THENπee% = (x% - r%) / 150 'Peashooterπef% = (g% - l%) / 150 'PeashooterπELSEπEND IFπab = 100πwinner:πIF etoggle% = 1 THENπetoggle% = 2πELSEIF etoggle% = 2 THENπetoggle% = 0πELSEπetoggle% = 1πEND IFπIF etoggle% = 1 OR etoggle% = 2 THEN ec% = 4πIF etoggle% = 0 THEN ec% = 0πIF loser% = 0 THEN ec% = 0πIF etoggle% = 0 THENπFOR s% = 1 TO 2πab = ab - .5πIF ab < 14 THEN EXIT FORπIF ewt% = 4 THENπee% = (x% - ex%) / ab 'Homing torpedoπef% = (g% - ey%) / ab 'Homing torpedo > the first IF a few lines down is also homingπELSEIF ewt% = 3 THENπee% = (x% - r%) / 150 'Drunk torpedoπef% = (g% - l%) / 150 'Drunk torpedoπELSEIF ewt% = 1 THENπee% = 0 'Laser > the third IF is everything but laserπef% = 8 'Laser > the fourth IF is laserπELSEπEND IFπIF leveltoggle% = 4 THENπFOR hilow% = 1 TO 2πex% = ex% + ee%πey% = ey% + ef%πPUT (ex%, ey%), Eshot, PSETπNEXT hilow%πELSEπex% = ex% + ee%πey% = ey% + ef%πPUT (ex%, ey%), Eshot, PSETπEND IFπNEXT s%πloser% = 4πIF ab < 12 OR ey% > 360 OR ex% < 25 OR ex% > 475 THEN etoggle% = 0: loser% = 0: Eshot% = 0: cool% = 0: Ek% = 1πIF ewt% = 2 OR ewt% = 3 OR ewt% = 4 THENπIF ex% > x% - 10 AND ex% < x% + 22 AND ey% > g% - 15 AND ey% < g% + 10 THEN GOTO 777πELSEπIF ex% > x% AND ex% < x% + 22 AND ey% > g% - 38 AND ey% < g% + 10 THEN GOTO 777πEND IFπEND IFπGOTO 7π777 :πIF ewt% = 1 THENπLINE (x% - 55, g% - 55)-(x% + 45, g% + 45), 0, BFπELSEπLINE (x% - 15, g% - 15)-(x% + 45, g% + 45), 0, BFπEND IFπDOπIF q% = 0 THENπq% = 1: c% = 4πELSEIF q% = 1 THENπq% = 2: c% = 4πELSEIF q% = 2 THENπq% = 0: c% = 15πEND IFπpee% = pee% + 1πCIRCLE (x% + 15, g% + 15), 15, 7πPAINT (x% + 15, g% + 15), c%, 7πLOOP UNTIL pee% = 150πDOπrc% = rc% + 1πrx% = RND * 40 + x%πrg% = RND * 40 + g%πPSET (rx%, rg%), 0πLOOP UNTIL rc% = 8000πCLSπlife% = life% - 1πIF life% < 0 THENπFOR I% = 1 TO 63πPALETTE 10, I%πLOCATE 10, 20πCOLOR 10πPRINT TAB(21); "╔═════════════════════════════════╗"πPRINT TAB(21); "║ ║"πPRINT TAB(21); "║ ): You have been killed :( ║"πPRINT TAB(21); "║ ║"πPRINT TAB(21); "╚═════════════════════════════════╝"πNEXT I%πPLAY "l2n0"πKeyy$ = UCASE$(INPUT$(1))πFOR d% = 63 TO 1 STEP -1πPALETTE 10, d%πLOCATE 10, 20πCOLOR 10πPRINT TAB(21); "╔═════════════════════════════════╗"πPRINT TAB(21); "║ ║"πPRINT TAB(21); "║ ): You have been killed :( ║"πPRINT TAB(21); "║ ║"πPRINT TAB(21); "╚═════════════════════════════════╝"πNEXT d%πLostGameπGOTO 10πELSEπGOTO raguExtraChunkyπEND IFπ10πSCREEN 13πEND SUBππSUB LostGameπDIM Ship(900)πg% = 400πx% = 288πTaps$ = "o2l2cl4cl1fl2cl4fl1al2cl4facfacfl1al2al4al1o3co2l2al4fl1cl2cl4cl1f"πStarNum% = 300πLNum% = 1πDIM StarX(StarNum%), StarY(StarNum%), Layer(LNum%)πLINE (10, 10)-(10, 20), 3π LINE (10, 18)-(20, 15), 3π LINE (25, 20)-(25, 10), 3π LINE (25, 18)-(19, 15), 3π LINE (18, 5)-(18, 15), 2πGET (31, 28)-(2, 1), ShipππCLSπFOR l = 1 TO LNum%πIF l = 1 THEN Layer(l) = 3πIF l = 2 THEN Layer(l) = 4πDO: k$ = "R": LOOP UNTIL k$ = "L" OR k$ = "R"πIF k$ = "L" THEN Layer(l) = -Layer(l)πPRINTπNEXT lπPLAY "MB X" + VARPTR$(Taps$)πFOR I% = 1 TO StarNum%πStarX(I%) = (RND * 619) + 1πStarY(I%) = (RND * 599) + 1πNEXT I%ππDOπFOR I% = 1 TO StarNum%πPSET (StarX(I%), StarY(I%)), 0πIF I% > (StarNum% / LNum%) * CL THEN CL = CL + 1πStarX(I%) = StarX(I%) + Layer(CL)πIF StarX(I%) < 1 THEN StarX(I%) = 619: StarY(I%) = RND * 619πIF StarX(I%) > 599 THEN StarX(I%) = 1: StarY(I%) = RND * 599πc% = (CL * 4) + 19πPSET (StarX(I%), StarY(I%)), c%πNEXT I%πIF g% > 20 AND boom% = 0 THENπFOR jkjkj% = 1 TO 3πg% = g% - 2.5πPUT (x%, g%), Ship, PSETπNEXT jkjkj%πEND IFπIF g% < 50 AND boom% = 0 THENπDOπIF q% = 0 THENπq% = 1: c% = 4πELSEIF q% = 1 THENπq% = 2: c% = 4πELSEIF q% = 2 THENπq% = 0: c% = 15πEND IFπpee% = pee% + 1πCIRCLE (x% + 15, g% + 15), 15, 7πPAINT (x% + 15, g% + 15), c%, 7πLOOP UNTIL pee% = 150πDOπrc% = rc% + 1πrx% = RND * 40 + x%πrg% = RND * 40 + g%πPSET (rx%, rg%), 0πLOOP UNTIL rc% = 8500πboom% = 1πEND IFπππCOLOR 15: LOCATE 8, 10πPRINT "I am disappointed with your utter failure in the Nebulatic battle."πPRINT " I've seen janitors do better (Space Quest, Moron). In World War II,"πPRINT " a bad pilot was considered a dead one. Guess where that puts you on"πPRINT " the top ten list!"πPRINT ""πPRINT " Press <ESC> To Continue"πLOOP UNTIL INKEY$ = CHR$(27)πIF g% > 20 THENπFOR jkjkj% = 1 TO 3πg% = g% - 2.5πPUT (x%, g%), Ship, PSETπNEXT jkjkj%πEND IFπGameEnd% = 1πEND SUBππSUB PacmanπSCREEN 12πDIM Ship(900)πDIM shot(800)πLINE (10, 10)-(10, 20), 3 'This draws the shipπLINE (10, 18)-(20, 15), 3πLINE (25, 20)-(25, 10), 3πLINE (25, 18)-(19, 15), 3πLINE (18, 5)-(18, 15), 2πGET (31, 28)-(2, 1), ShipπCLSπLINE (2, 5)-(2, 40), 3πGET (1, 70)-(2, 1), shotπCLSπbarney$ = "o2l6gel3gl6gel3gl6ao2l6gel3gl6gel3gl6a"πpacx = 320πpacy = 240πh% = 420πg% = 420πx% = 320πs% = 0πCONST ArraySize = 242, NumGraphics = 21πCONST Delay = 700πCONST True = -1, False = NOT TrueπDIM Graphic(0 TO ArraySize * NumGraphics)πGOSUB MakeDataπCLSπPLAY "MB X" + VARPTR$(barney$)πDOπFOR Frame = 0 TO 6 STEP 2πPUT (pacx, pacy), Graphic(Frame * ArraySize), PSETπFOR Stall = 0 TO Delay: NEXTπIF pacx < 384 THEN pacx = pacx + 3πNEXTπIF pacx > 195 AND pacx < 225 THEN GOSUB xwingπIF pacx > 225 THEN GOSUB firingπFOR Frame = 6 TO 0 STEP -2πPUT (pacx, pacy), Graphic(Frame * ArraySize), PSETπFOR Stall = 0 TO Delay: NEXTπIF pacx < 386 THEN pacx = pacx + 3πNEXTπIF pacx > 195 AND pacx < 225 THEN GOSUB xwingπIF pacx > 225 THEN GOSUB firingπIF pacx = 386 THEN NumTurns = 0πIF pacx = 10 OR pacy = 10 THENπs% = s% + 1πLOCATE 1, 8: PRINT s%πEND IFπIF pacx > 195 AND pacx < 225 THEN GOSUB xwingπIF pacx > 225 THEN GOSUB firingπLOOPπGOTO endsπMakeData:πFOR pacx = 1 TO 10πCIRCLE (20, 20), pacx, 14πCIRCLE (21, 20), pacx, 14πNEXT pacxπLINE (20, 14)-STEP(2, 1), 0, BFπGOSUB SaveGraphicπLINE (20, 20)-(31, 20), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 19), 0πLINE (20, 20)-(31, 21), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 18), 0πLINE (20, 20)-(31, 22), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 17), 0πLINE (20, 20)-(31, 23), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 16), 0πLINE (20, 20)-(31, 24), 0πGOSUB SaveGraphicπLINE (20, 20)-(31, 15), 0πLINE (20, 20)-(31, 25), 0πGOSUB SaveGraphicπSaveGraphic:πGET (6, 11)-(32, 29), Graphic(Offset)πOffset = Offset + ArraySizeπRETURNπxwing:πIF tea% = 1 THEN GOTO teeπtea% = 1πGOSUB MMusicπtee:πIF g% > 360 THENπFOR l = 1 TO 2πg% = g% - 4πPUT (x%, g%), Ship, PSETπNEXTπEND IFπPUT (x%, g%), Ship, PSETπRETURNπfiring:πIF h% < 255 THEN GOTO endsπIF tick% = 1 THEN GOTO tickeπtick% = 1πh% = g% + 12πticke:πh% = h% - 15πPUT (x%, h%), shot, PSETπRETURNπMMusic:πCount% = Count% + 1πMBuff$ = "T150L2O2CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πPLAY "MB X" + VARPTR$(MBuff$)πRETURNπends:πCIRCLE (320, 240), 40, 12πDRAW "P4,12"πDRAW "BM0,0 P8,12"πFOR I = 2 TO 100πCIRCLE (320, 240), I, 14πCIRCLE (320, 240), I, 0πNEXT IπFOR I = 100 TO 410π'IF i = 290 THEN GOSUB MMusicπCIRCLE (320, 240), I, 14πCIRCLE (320, 240), (I - 99) * 2, 15πCIRCLE (320, 240), I - 2, 0πCIRCLE (320, 240), ((I - 99) * 2) - 2, 0πNEXT IπEND SUBππSUB TheStoryπSCREEN 12πCLSπA% = 25πk% = 25πStarNum% = 150πLNum% = 2πDIM StarX(StarNum%), StarY(StarNum%), Layer(LNum%)πFOR l = 1 TO LNum%πIF l = 1 THEN Layer(l) = 3πIF l = 2 THEN Layer(l) = 4πDO: k$ = "R": LOOP UNTIL k$ = "L" OR k$ = "R"πIF k$ = "L" THEN Layer(l) = -Layer(l)πPRINTπNEXT lπ'PLAY ONπ'PRINT "Music? [Y/N]";π'WHILE A$ <> "Y" AND A$ <> "N": A$ = "Y": WENDπ'IF A$ = "Y" THEN MBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"π'PLAY "MB X" + VARPTR$(MBuff$)πSCREEN 12πFOR I% = 1 TO StarNum%πStarX(I%) = (RND * 619) + 1πStarY(I%) = (RND * 599) + 1πNEXT I%πDOππIF A% > 1 THENπA% = A% - 1πLOCATE A%, 25: PRINT "Federation Defender"πB% = A% + 1πLOCATE B%, 25: PRINT " "πEND IFπIF A% < 2 THENπLOCATE A%, 25: PRINT " "πIF s% = 0 THENπLOCATE 10, 1πA$ = " You are the defender of a long time war galaxy. You must defeat the"πB$ = "evil aliens from planet Nebulats. Until now, the nebulatic creatures have"πc$ = "been winning the war, but now the planet Vanderbet (your home planet) is"πd$ = "launching an all-out strike against them. You are the Alpha leader, and"πe$ = "your job is to defeat the front lines of the Nebulatic army. Your ship"πf$ = "is equipped with Class III Lasers, but can interface with Nebulatic"πg$ = "weapons."πh$ = "Press <Spacebar> To Continue"πFOR w = 1 TO LEN(A$): SOUND 200, .1: LOCATE 10, 4: PRINT LEFT$(A$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(B$): SOUND 200, .1: LOCATE 11, 4: PRINT LEFT$(B$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(c$): SOUND 200, .1: LOCATE 12, 4: PRINT LEFT$(c$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(d$): SOUND 200, .1: LOCATE 13, 4: PRINT LEFT$(d$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(e$): SOUND 200, .1: LOCATE 14, 4: PRINT LEFT$(e$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(f$): SOUND 200, .1: LOCATE 15, 4: PRINT LEFT$(f$, w): FOR q = 1 TO 500: NEXT q: NEXTπFOR w = 1 TO LEN(g$): SOUND 200, .1: LOCATE 16, 4: PRINT LEFT$(g$, w): FOR q = 1 TO 500: NEXT q: NEXTπCOLOR 14: SOUND 440, 1: FOR q = 1 TO 500: NEXT qπFOR w = 1 TO LEN(h$): SOUND 240 + w, 1: LOCATE 17, 46: PRINT LEFT$(h$, w): FOR q = 1 TO 500: NEXT q: NEXTπPRINT " "πs% = 1πEND IFπEND IFπIF s% = 2 THENπLOCATE 10, 1: PRINT " "πPRINT " "πPRINT " "πPRINT " "πPRINT " "πLOCATE 16, 20: PRINT " The Story is not done "πEND IFπCL = 1πFOR I% = 1 TO StarNum%πPSET (StarX(I%), StarY(I%)), 0πIF I% > (StarNum% / LNum%) * CL THEN CL = CL + 1πStarX(I%) = StarX(I%) + Layer(CL)πIF StarX(I%) < 1 THEN StarX(I%) = 619: StarY(I%) = RND * 619πIF StarX(I%) > 599 THEN StarX(I%) = 1: StarY(I%) = RND * 599πc% = (CL * 4) + 19πPSET (StarX(I%), StarY(I%)), c%πNEXT I%πPLAY ONπLOOP UNTIL INKEY$ = " "πGOTO 28ππ'MuchMusic:πCount% = Count% + 1πSELECT CASE Count%πCASE 0: MBuff$ = "T150L2O3CGP16L16FEDL2>C<GP16L16FEDL2>C<GP16L16FEFL2D"πCASE 1: MBuff$ = "P16L16<GGGL2>CGP32L16FEDL2>C<GP16L16FEDL2>C<GP16L16A+"πCASE 2: MBuff$ = "AA+L1GL2G.L8<G.L16GL4A.L8A>FEDCL16CDEDP16L8"πCASE 3: MBuff$ = "<AL4BL8G.L16G"πCASE 4: MBuff$ = "L4A.L8A>FEDCGP8L4D.P8L8<G.L16GL4A.L8A>FEDCL16"πCASE 5: MBuff$ = "CDEDP16L8<A"πCASE 6: MBuff$ = "L4BP16L8>G.L16GL8>C.L16<A+L8G+.L16GL8F.L16D+L8D.L16CL1G"πCASE 7: MBuff$ = "L2G.P16L16GGGL8>CP8L16<CCCL2C.": Count% = -1πEND SELECTπ'PLAY "MB X" + VARPTR$(MBuff$)πRETURNπ28πSCREEN 13πEND SUBπAkarsha Vasant Kumar MINESWEEPER FOR DOS avkumar@giasbm01.vsnl.net.in 08-30-96 (10:20) QB, PDS 1102 26691 MINESWEE.BAS'###########################################################################π'########################### MINESWEEPER FOR DOS ###########################π'###########################################################################π'π' --- AKARSHA V. KUMARπ' Bombay , INDIA.ππ'Viola ! Now here's a real beaut . Took a lot of my time, but it works realπ'well ! There might be a few bugs ( tho me not find one ) and I would reallyπ'appreciate it if you point 'em out me so that I could fix 'em .π'I had to steal a few subroutines from previous ABCs and being the Mr.Niceπ'that I undoubtably am, I think I'll give these chaps some credit .π'Many thanx to :---π'1) Chris Wagner ( mouse subroutine ; the best I could find )π'2) Erik Olson ( Edit Box subroutine ; real neat function )π'Keep up the good work guys and I'll always come up with an application !π'I was going to include a custom setup utility . I had already started makingπ'a subroutine . That I didn't find it challenging enough to get my grey cellsπ'ticking is a different story altogether ! . So u programming tyros out thereπ'vying to get ur names on the ABC, go ahead n' complete it if you want .π'And u programming gurus out there, tell me if you make any changes and doπ'ask me before ripping it apart .πππ'Coming Attraction :π'Watch out for WARSHIP I : A superb(?) space game with real neatπ' grafix n' sound ( varooom! varooom!! )ππ' Minesweeper 4 Dos : Source CodeππREM $INCLUDE: 'QBX.BI'ππDECLARE SUB FANCYPRINT (MSG$, X!, Y!)πDECLARE SUB VLINE (Y1!, Y2!, X!)πDECLARE SUB HLINE (X1!, X2!, Y!)πDECLARE SUB DELAY (D!)πDECLARE SUB DBLBOX (X1!, Y1!, X2!, Y2!, COLOR1, COLOR2)πDECLARE SUB BOX (X1!, Y1!, X2!, Y2!, COLOR1, COLOR2)πDECLARE SUB MOUSEON ()πDECLARE SUB MOUSEOFF ()πDECLARE SUB MouseSetHor (Min%, Max%)πDECLARE SUB MouseSetVert (Min%, Max%)πDECLARE SUB MouseLocate (Xpos%, Ypos%)πDECLARE SUB MouseStatus (VERT%, HOR%, MBUTTONS$)πDECLARE FUNCTION MouseInstalled% ()πDECLARE SUB AROUNDBOXCLEAR (I, J)πDECLARE SUB CLEARAROUNDZERO (I, J)πDECLARE SUB SHOWMINES ()πDECLARE SUB MENU ()πDECLARE SUB LEVELS ()πDECLARE SUB HELP ()πDECLARE SUB START ()πDECLARE SUB ABOUT ()πDECLARE SUB HISCORE ()πDECLARE SUB SHOWHISCORE ()πDECLARE SUB RESETSCORES ()πDECLARE SUB CHECKTIME ()πDECLARE FUNCTION EDITBOX$ (DEFAULT$, X, Y)πDECLARE SUB CUSTOMBOX ()ππTYPE INFOπ FNAME AS STRING * 12π time AS STRING * 10π DATE AS STRING * 10πEND TYPEπDIM SHARED PLAYER AS INFOπDIM SHARED NUMOFBLOCKS AS INTEGERπDIM SHARED NEWGAMECANCELLEDπDIM SHARED NEWGAMEπDIM SHARED RegX AS RegTypeXπDIM SHARED WONπDIM SHARED LOSTπDIM SHARED TIMENOWππ CALL MouseSetHor(1, 80)π CALL MouseSetVert(1, 25)π CALL MouseLocate(20, 70)π CALL MOUSEONππSCREEN , , 1, 1πCLSπCALL STARTπCALL MENUπNEWGAME = 0: WON = 0: LOST = 0ππSTART:ππRANDOMIZE TIMER: TIMER ONπTYPE PROPERTIESπ STARTX AS INTEGERπ STARTY AS INTEGERπ CONTENT AS STRING * 1π CLEARED AS INTEGERπ MARKED AS INTEGERπ QMARKED AS INTEGERπ ZEROCLEARED AS INTEGERπ DRAWN AS INTEGERπEND TYPEππ'NUMOFBLOCKS = 25πNUMOFCOLS = 7πNUMOFMARKERS = NUMOFBLOCKSπNUMOFMINES = NUMOFBLOCKSππREDIM SHARED BLOCK(NUMOFBLOCKS, NUMOFCOLS) AS PROPERTIESπWON = 0: LOST = 0πNUMCLEARED = 0ππSCREEN , , 1, 1πCLSππLOCATE 25, 10: PRINT "Number of markers :"πLOCATE 25, 50: PRINT "Time :"πCOLOR 14, 12: LOCATE 25, 35: PRINT " MENU "ππFOR I = 1 TO NUMOFBLOCKSπFOR J = 1 TO NUMOFCOLSπBLOCK(I, J).CONTENT = ""πBLOCK(I, J).CLEARED = 0πBLOCK(I, J).MARKED = 0πBLOCK(I, J).QMARKED = 0πNEXT JπNEXT IππTEMP = 0π5 FOR MINE = 1 TO NUMOFBLOCKSπ10 I = INT(RND * NUMOFBLOCKS) + 1: J = INT(RND * 6) + 1πIF BLOCK(I, J).CONTENT = CHR$(21) THENπGOTO 10πELSE BLOCK(I, J).CONTENT = CHR$(21)πTEMP = TEMP + 1πEND IFπNEXT MINEπIF TEMP <> NUMOFBLOCKS THEN GOTO 5ππFOR X = 1 TO NUMOFBLOCKSπFOR Y = 1 TO NUMOFCOLSπTEMP = 0πIF BLOCK(X, Y).CONTENT <> CHR$(21) THENπIF X <> 1 AND Y <> 1 THENπIF BLOCK(X - 1, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF Y <> 1 THENπIF BLOCK(X, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> NUMOFBLOCKS AND Y <> 1 THENπIF BLOCK(X + 1, Y - 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> 1 THENπIF BLOCK(X - 1, Y).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> NUMOFBLOCKS THENπIF BLOCK(X + 1, Y).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> 1 AND Y <> NUMOFCOLS THENπIF BLOCK(X - 1, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF Y <> NUMOFCOLS THENπIF BLOCK(X, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπIF X <> NUMOFBLOCKS AND Y <> NUMOFCOLS THENπIF BLOCK(X + 1, Y + 1).CONTENT = CHR$(21) THEN TEMP = TEMP + 1πEND IFπBLOCK(X, Y).CONTENT = LTRIM$(STR$(TEMP))πEND IFπNEXT YπNEXT XππDRAWX = INT((80 - NUMOFBLOCKS * 3) / 2)πCALL DBLBOX(DRAWX - 1, 1, DRAWX + NUMOFBLOCKS * 3 + 2, 23, 11, 1)πFOR X = 1 TO NUMOFBLOCKSπFOR Y = 0 TO 6πCALL BOX(DRAWX - 2 + X * 3, Y * 3 + 2, DRAWX + X * 3, Y * 3 + 4, 1, 11)πBLOCK(X, Y + 1).STARTX = DRAWX - 2 + X * 3: BLOCK(X, Y + 1).STARTY = Y * 3 + 2π'LOCATE Y * 3 + 3, X * 3 + 1: PRINT BLOCK(X, Y + 1).CONTENTπNEXT YπNEXT XπCOLOR 10, 0ππLOCATE 4, 50π πTIMEST = 0ππDOπ CALL MouseStatus(VERT%, HOR%, MBUTTONS$)π a$ = UCASE$(INKEY$)ππ IF MBUTTONS$ = "L" THENπ IF VERT% = 25 AND HOR% >= 35 AND HOR% <= 43 THENπ CALL MENUπ STARTIME = STARTIME + (TIMER - (STARTIME + TIMENOW))π END IFπ IF NEWGAME = 1 THEN NEWGAME = 0: GOTO STARTπ FOR I = 1 TO NUMOFBLOCKSπ FOR J = 1 TO NUMOFCOLSπ IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THENπ IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THENπ IF TIMEST = 0 THENπ STARTIME = TIMER: TIMEST = 1π END IFπ BLOCK(I, J).CLEARED = 1π BLOCK(I, J).MARKED = 0: BLOCK(I, J).QMARKED = 0π END IFππ END IFπ NEXT Jπ NEXT Iπ END IFππIF NEWGAME = 1 THEN NEWGAME = 0: GOTO STARTπ IF MBUTTONS$ = "LR" THENππ FOR I = 1 TO NUMOFBLOCKSπ FOR J = 1 TO NUMOFCOLSπ IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THENπ IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THENπ IF TIMEST = 0 THENπ STARTIME = TIMER: TIMEST = 1π END IFππ IF BLOCK(I, J).CLEARED = 1 THENπ CALL AROUNDBOXCLEAR(I, J)π END IFπ END IFπ END IFπ NEXT Jπ NEXT Iππ END IFππ IF MBUTTONS$ = "R" THENπ FOR I = 1 TO 5000: NEXT Iπ FOR I = 1 TO NUMOFBLOCKSπ FOR J = 1 TO NUMOFCOLSπ IF HOR% >= BLOCK(I, J).STARTX AND HOR% <= BLOCK(I, J).STARTX + 2 THENπ IF VERT% >= BLOCK(I, J).STARTY AND VERT% <= BLOCK(I, J).STARTY + 2 THENπ IF TIMEST = 0 THENπ STARTIME = TIMER: TIMEST = 1π END IFπ π IF BLOCK(I, J).CLEARED = 0 THENππ IF BLOCK(I, J).MARKED = 1 THENπ BLOCK(I, J).MARKED = 0: BLOCK(I, J).QMARKED = 1: NUMOFMARKERS = NUMOFMARKERS + 1π π X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπ CALL DBLBOX(X, Y, X + 2, Y + 2, 14, 5): COLOR 14, 5ππ LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT "?"πππ π ELSEIF BLOCK(I, J).MARKED = 0 AND BLOCK(I, J).QMARKED = 0 THENπ IF NUMOFMARKERS <> 0 THENπ BLOCK(I, J).MARKED = 1: : NUMOFMARKERS = NUMOFMARKERS - 1π π X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπ COLOR 1, 10: CALL DBLBOX(X, Y, X + 2, Y + 2, 14 + 16, 12): COLOR 14 + 16, 12ππ LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT "M"π END IFππ ELSEIF BLOCK(I, J).QMARKED = 1 THENπ BLOCK(I, J).QMARKED = 0: BLOCK(I, J).MARKED = 0π π X = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπ COLOR 2, 0: CALL BOX(X, Y, X + 2, Y + 2, 1, 11): COLOR 1, 11ππ LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT ""ππ END IFπ END IFπ π END IFππ END IFππ NEXT Jπ NEXT Iππ END IFππCOLOR 15, 0πLOCATE 25, 30: PRINT LTRIM$(STR$(NUMOFMARKERS)) + " ";πIF TIMEST = 1 THENπTIMENOW = TIMER - STARTIMEπLOCATE 25, 57: PRINT USING "####.##"; TIMENOW;πEND IFπ πIF a$ = "Q" THEN CALL MOUSEOFF: SYSTEMππFOR I = 1 TO NUMOFBLOCKSπFOR J = 1 TO NUMOFCOLSππIF BLOCK(I, J).CLEARED = 1 THENπNUMCLEARED = NUMCLEARED + 1ππIF BLOCK(I, J).MARKED = 0 AND BLOCK(I, J).DRAWN = 0 THENπX = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπCALL BOX(X, Y, X + 2, Y + 2, 8, 0)πIF BLOCK(I, J).CONTENT <> "0" THEN LOCATE BLOCK(I, J).STARTY + 1, BLOCK(I, J).STARTX + 1: PRINT BLOCK(I, J).CONTENTπBLOCK(I, J).DRAWN = 1πEND IFππIF BLOCK(I, J).CONTENT = CHR$(21) AND BLOCK(I, J).MARKED = 0 THENπLOST = 1πCALL SHOWMINESπSLEEP (2)πCALL BOX(25, NUMOFCOLS, 55, 13, 13, 1)πCOLOR 2, 1πFOR X = 26 TO 54πFOR Y = 8 TO 12πLOCATE Y, X: PRINT CHR$(21)πNEXT YπNEXT XπCOLOR 13, 1πLOCATE 10, 31: PRINT " Block Has Mine !! "πSLEEP (2)πCALL MENUππEND IFππIF BLOCK(I, J).CONTENT = "0" AND BLOCK(I, J).ZEROCLEARED = 0 THENπCALL CLEARAROUNDZERO(I, J)πBLOCK(I, J).ZEROCLEARED = 1πEND IFππEND IFππNEXT JπNEXT IπIF NUMCLEARED = NUMOFBLOCKS * NUMOFCOLS - NUMOFMINES AND NEWGAMECANCELLED = 0 THENπWON = 1πCALL BOX(25, NUMOFCOLS, 55, 13, 14, 0)πCOLOR 2, 1πFOR X = 26 TO 54πFOR Y = 8 TO 12πLOCATE Y, X: PRINT CHR$(2)πNEXT YπNEXT XπCOLOR 12, 1πLOCATE 10, 34: PRINT " YOU WIN !! "πSLEEP (2)πCALL CHECKTIMEπCALL MENUπELSE NUMCLEARED = 0πEND IFππ LOOPππDATA "`MINESWEEPER' is a game involving skill and lotsa luck ."πDATA "All ya guys gotta do is to clear a minefield without "πDATA "blasting a mine . The number of markers at the start of "πDATA "game is = the number of mines in the grid . Click with "πDATA "the left mouse button to clear a block . The number that"πDATA "a cleared block shows is the number of blocks touching it"πDATA "which contain mines . If you are sure that a block has"πDATA "a mine then use the right mouse button to mark it . If "πDATA "you are doubtful about its contents , another click will"πDATA "question mark the block . A third click unmarks the block.πDATA "Clickin' both buttons together , clears all blocks around "πDATA "a block except those that have been marked previously."πDATA "For more help , go play the Windows version (He He He...)"ππSUB ABOUTπCALL MOUSEOFFπPCOPY 3, 4πCALL MOUSEONππCALL DBLBOX(15, 4, 64, 22, 12, 10)πCOLOR 8, 8:πFOR I = 16 TO 65πa = SCREEN(23, I)πLOCATE 23, I: PRINT CHR$(a)πNEXT IπFOR J = 5 TO 22πa = SCREEN(J, 65)πLOCATE J, 65: PRINT CHR$(a)πNEXT JππFOR I = 23 TO 53 STEP 3πCALL BOX(I, 5, I + 2, 7, 14, 12)πNEXT IπTITLE$ = "MINESWEEPER"πCOLOR 14, 12πFOR I = 1 TO 11πa$ = MID$(TITLE$, I, 1)πCALL FANCYPRINT(a$, 6, I * 3 + 21)πNEXT IπCALL BOX(36, 18, 46, 20, 1, 0)πCALL BOX(35, 17, 45, 19, 1, 15)πCOLOR 1, 15: LOCATE 18, 39: PRINT "OK"πCOLOR 10, 2πCALL FANCYPRINT("For DOS", 8, 35)πCALL FANCYPRINT("Version : 1.0 (1996)", 9, 29)πCALL FANCYPRINT("By : Akarsha V.Kumar , Bombay ,India .", 10, 21)πCALL FANCYPRINT("For comments and bugs e-mail me at :", 11, 21)πCALL FANCYPRINT("avkumar@giasbm01.vsnl.net.in", 12, 24)πCALL FANCYPRINT("You are free to distribute this game .", 13, 21)πCALL FANCYPRINT("You may not expect future versions", 14, 22)πCALL FANCYPRINT("'cos this game ain't got no future .", 15, 21)ππDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 17 AND VERT% <= 19 AND HOR% >= 35 AND HOR% <= 45 THENπEXIT DOπEND IFπEND IFπLOOPππPCOPY 4, 3πSCREEN , , 3, 3ππEND SUBππSUB AROUNDBOXCLEAR (I, J)ππIF I <> 1 AND J <> 1 THENπIF BLOCK(I - 1, J - 1).MARKED = 0 THEN BLOCK(I - 1, J - 1).CLEARED = 1πEND IFπIF J <> 1 THENπIF BLOCK(I, J - 1).MARKED = 0 THEN BLOCK(I, J - 1).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS AND J <> 1 THENπIF BLOCK(I + 1, J - 1).MARKED = 0 THEN BLOCK(I + 1, J - 1).CLEARED = 1πEND IFπIF I <> 1 THENπIF BLOCK(I - 1, J).MARKED = 0 THEN BLOCK(I - 1, J).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS THENπIF BLOCK(I + 1, J).MARKED = 0 THEN BLOCK(I + 1, J).CLEARED = 1πEND IFπIF I <> 1 AND J <> 7 THENπIF BLOCK(I - 1, J + 1).MARKED = 0 THEN BLOCK(I - 1, J + 1).CLEARED = 1πEND IFπIF J <> 7 THENπIF BLOCK(I, J + 1).MARKED = 0 THEN BLOCK(I, J + 1).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS AND J <> 7 THENπIF BLOCK(I + 1, J + 1).MARKED = 0 THEN BLOCK(I + 1, J + 1).CLEARED = 1πEND IFππEND SUBππSUB BOX (X1, Y1, X2, Y2, COLOR1, COLOR2)ππ'DRAW HORIZONTAL LINESππCOLOR COLOR1, COLOR2πIF X1 > X2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERX = X1: LESSERX = X2πELSEπGREATERX = X2: LESSERX = X1πEND IFππFOR I = (LESSERX + 1) TO (GREATERX - 1)πLOCATE Y1, I: PRINT CHR$(196);πLOCATE Y2, I: PRINT CHR$(196);πNEXT Iππ'DRAW VERTICAL LINESππIF Y1 > Y2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERY = Y1: LESSERY = Y2πELSEπGREATERY = Y2: LESSERY = Y1πEND IFππFOR I = LESSERY + 1 TO GREATERY - 1πLOCATE I, X1: PRINT CHR$(179);πLOCATE I, X2: PRINT CHR$(179);πNEXT Iππ'DRAW CORNERSπLOCATE LESSERY, LESSERX: PRINT CHR$(218);πLOCATE GREATERY, GREATERX: PRINT CHR$(217);πLOCATE LESSERY, GREATERX: PRINT CHR$(191);πLOCATE GREATERY, LESSERX: PRINT CHR$(192);ππFOR I = LESSERX + 1 TO GREATERX - 1πFOR J = LESSERY + 1 TO GREATERY - 1πLOCATE J, I: PRINT " ";πNEXT JπNEXT IππCOLOR 7, 0πEND SUBππSUB CHECKTIMEπOPEN "HISCORE.DAT" FOR RANDOM AS #1ππFOR I = 1 TO 4πIF NUMOFBLOCKS = I * 5 + 5 THENπGET #1, I, PLAYERπIF TIMENOW < VAL(PLAYER.time) THENπCALL BOX(20, 6, 60, 14, 0, 15)πCOLOR 2, 1πFOR X = 21 TO 59πFOR Y = 7 TO 13πLOCATE Y, X: PRINT CHR$(2)πNEXT YπNEXT XπCOLOR 0, 15πLOCATE 6, 25: PRINT " HI SCORE :"πCOLOR 15, 1πLOCATE 8, 25: PRINT " You have made a new record. "πLOCATE 9, 25: PRINT " Please enter your name :- "πPLAYER.FNAME = EDITBOX$(" ", 34, 11)πPLAYER.time = STR$(TIMENOW)πPLAYER.DATE = DATE$πPUT #1, I, PLAYERπCLOSE #1πCALL SHOWHISCOREπEXIT FORπEND IFπEND IFπNEXT IπCLOSE #1πEND SUBππSUB CLEARAROUNDZERO (I, J)ππIF I <> 1 AND J <> 1 THENπIF BLOCK(I - 1, J - 1).MARKED = 0 AND BLOCK(I - 1, J - 1).CONTENT <> "M" THEN BLOCK(I - 1, J - 1).CLEARED = 1πEND IFπIF J <> 1 THENπIF BLOCK(I, J - 1).MARKED = 0 AND BLOCK(I, J - 1).CONTENT <> "M" THEN BLOCK(I, J - 1).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS AND J <> 1 THENπIF BLOCK(I + 1, J - 1).MARKED = 0 AND BLOCK(I + 1, J - 1).CONTENT <> "M" THEN BLOCK(I + 1, J - 1).CLEARED = 1πEND IFπIF I <> 1 THENπIF BLOCK(I - 1, J).MARKED = 0 AND BLOCK(I - 1, J).CONTENT <> "M" THEN BLOCK(I - 1, J).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS THENπIF BLOCK(I + 1, J).MARKED = 0 AND BLOCK(I + 1, J).CONTENT <> "M" THEN BLOCK(I + 1, J).CLEARED = 1πEND IFπIF I <> 1 AND J <> 7 THENπIF BLOCK(I - 1, J + 1).MARKED = 0 AND BLOCK(I - 1, J + 1).CONTENT <> "M" THEN BLOCK(I - 1, J + 1).CLEARED = 1πEND IFπIF J <> 7 THENπIF BLOCK(I, J + 1).MARKED = 0 AND BLOCK(I, J + 1).CONTENT <> "M" THEN BLOCK(I, J + 1).CLEARED = 1πEND IFπIF I <> NUMOFBLOCKS AND J <> 7 THENπIF BLOCK(I + 1, J + 1).MARKED = 0 AND BLOCK(I + 1, J + 1).CONTENT <> "M" THEN BLOCK(I + 1, J + 1).CLEARED = 1πEND IFππEND SUBππSUB CUSTOMBOXπCALL MOUSEOFFπPCOPY 5, 6πCALL MOUSEONπCUSTOMROW = 28ππCALL DBLBOX(20, 3, 60, 20, 1, 2)πCOLOR 10, 0πLOCATE 6, 27: PRINT CHR$(17)πLOCATE 6, 54: PRINT CHR$(16)πCOLOR 10, 2πFOR I = 28 TO 53πLOCATE 6, I: PRINT CHR$(176)πNEXT IπLOCATE 6, CUSTOMROW: PRINT CHR$(219)πCALL BOX(36, 16, 46, 18, 1, 0)πCALL BOX(35, 15, 45, 17, 1, 15)πDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% = 6 THENπIF HOR% = 27 THENπDELAY (2000)πIF CUSTOMROW > 28 THEN CUSTOMROW = CUSTOMROW - 1πEND IFπIF HOR% = 54 THENπDELAY (2000)πIF CUSTOMROW < 53 THEN CUSTOMROW = CUSTOMROW + 1πEND IFπEND IFπIF VERT% >= 15 AND VERT% <= 17 AND HOR% >= 35 AND HOR% <= 45 THENπEXIT DOπEND IFπCOLOR 10, 0πLOCATE 6, 27: PRINT CHR$(17)πLOCATE 6, 54: PRINT CHR$(16)πCOLOR 10, 2πFOR I = 28 TO 53πLOCATE 6, I: PRINT CHR$(176)πNEXT IπLOCATE 6, CUSTOMROW: PRINT CHR$(219)πEND IFπLOOPπDELAY (5000)πPCOPY 6, 5πSCREEN , , 5, 5πEND SUBππSUB DBLBOX (X1, Y1, X2, Y2, COLOR1, COLOR2)ππ'CHECK FOR VALID CO-ORDINATESπIF X1 > 80 OR X1 < 1 OR X2 > 80 OR X2 < 1 OR Y1 > 24 OR Y1 < 1 OR Y2 > 24 OR Y2 < 1 THEN GOTO 100ππCOLOR COLOR1, COLOR2ππIF X1 > X2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERX = X1: LESSERX = X2πELSEπGREATERX = X2: LESSERX = X1πEND IFππ'DRAW HORIZONTAL LINESπFOR I = (LESSERX + 1) TO (GREATERX - 1)πLOCATE Y1, I: PRINT CHR$(205);πLOCATE Y2, I: PRINT CHR$(205);πNEXT Iππ'DRAW VERTICAL LINESππIF Y1 > Y2 THEN ' DETERMINE GREATER CO-ORDINATEπGREATERY = Y1: LESSERY = Y2πELSEπGREATERY = Y2: LESSERY = Y1πEND IFππFOR I = LESSERY + 1 TO GREATERY - 1πLOCATE I, X1: PRINT CHR$(186);πLOCATE I, X2: PRINT CHR$(186);πNEXT Iππ'DRAW CORNERSπLOCATE LESSERY, LESSERX: PRINT CHR$(201);πLOCATE GREATERY, GREATERX: PRINT CHR$(188);πLOCATE LESSERY, GREATERX: PRINT CHR$(187);πLOCATE GREATERY, LESSERX: PRINT CHR$(200);ππFOR I = LESSERX + 1 TO GREATERX - 1πFOR J = LESSERY + 1 TO GREATERY - 1πLOCATE J, I: PRINT " ";πNEXT JπNEXT IππCOLOR 7, 0ππ100 END SUBππSUB DELAY (D)πFOR I = 1 TO DπNEXT IπEND SUBππFUNCTION EDITBOX$ (DEFAULT$, X, Y)πDOππ LOCATE Y, X: PRINT DEFAULT$' if you want to put the box somewhereπ LOCATE Y, X + YY: PRINT CHR$(2) ' else, change these locate statementsπππ DO: a$ = INKEY$: LOOP WHILE LEN(a$) = 0π IF LEN(a$) THENπ SELECT CASE (a$)π CASE CHR$(27), CHR$(13)π 'END SELECTπ CASE CHR$(8)π IF YY THENπ YY = YY - 1π IF YY THENπ DEFAULT$ = LEFT$(DEFAULT$, YY) + MID$(DEFAULT$, YY + 2) + " "π ELSEπ DEFAULT$ = MID$(DEFAULT$, YY + 2) + " "π END IFπ END IFπ CASE CHR$(0) + CHR$(83)π IF YY THENπ DEFAULT$ = LEFT$(DEFAULT$, YY) + MID$(DEFAULT$, YY + 2) + " "π ELSEπ DEFAULT$ = MID$(DEFAULT$, YY + 2) + " "π END IFπ CASE CHR$(0) + CHR$(&H4D)π IF YY < LEN(DEFAULT$) THEN YY = YY + 1π CASE CHR$(0) + CHR$(&H4B)π IF YY THEN YY = YY - 1π CASE CHR$(0) + CHR$(79)'endπ YY = LEN(RTRIM$(DEFAULT$))π CASE CHR$(0) + CHR$(71)π YY = 0ππ CASE ELSEπ IF LEN(a$) = 1 AND YY = 0 THEN DEFAULT$ = SPACE$(LEN(DEFAULT$))π IF LEN(a$) = 1 AND YY < LEN(DEFAULT$) THEN MID$(DEFAULT$, YY + 1, 1) = a$: YY = YY + 1ππ END SELECTπ IF a$ = CHR$(27) THEN EDITBOX$ = "": EXIT DOπ IF a$ = CHR$(13) THEN EDITBOX$ = RTRIM$(DEFAULT$): EXIT DOππ END IFπLOOPπEND FUNCTIONππSUB FANCYPRINT (MSG$, X, Y)πLOCATE X, YπFOR I = 1 TO LEN(MSG$)πM$ = MID$(MSG$, I, 1)πPRINT M$; : IF M$ = " " THEN SOUND 500, 1πDELAY (750)πNEXT IπEND SUBππSUB HELPππCALL MOUSEOFFπPCOPY 3, 4πCALL MOUSEONπCALL DBLBOX(5, 2, 75, 23, 0, 13)πCOLOR 14, 13πLOCATE 3, 29: PRINT " MINESWEEPER HELP "ππCOLOR 0, 13πFOR Y = 5 TO 17πREAD HLP$πLOCATE Y, 10: PRINT HLP$πNEXT YπCALL BOX(35, 20, 45, 22, 1, 1)πCALL BOX(34, 19, 44, 21, 1, 15)πCOLOR 1, 15πLOCATE 20, 38: PRINT "OK"πDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 19 AND VERT% <= 21 AND HOR% >= 34 AND HOR% <= 44 THENπEXIT DOπEND IFπEND IFπLOOPππRESTOREπPCOPY 4, 3πSCREEN , , 3, 3ππEND SUBππSUB HISCOREππEND SUBππSUB HLINE (X1, X2, Y)ππ'DETERMINE GREATER X CO-ORDINATEπIF X1 > X2 THENπGREATER = X1: LESSER = X2πELSEπGREATER = X2: LESSER = X1πEND IFπFOR I = LESSER TO GREATERπLOCATE Y, I: PRINT CHR$(196)πNEXT IππEND SUBππSUB LEVELSπCALL MOUSEOFFπPCOPY 3, 4: PCOPY 4, 5πCALL MOUSEONπSCREEN , , 5, 5πCALL DBLBOX(10, 5, 70, 20, 0, 12)ππFOR X = 15 TO 35 STEP 19πFOR Y = 7 TO 14 STEP 7πCALL BOX(X + 1, Y + 1, X + 14, Y + 3, 8, 8)πCALL BOX(X, Y, X + 13, Y + 2, 1, 15)πNEXT YπNEXT XπCALL BOX(53, 12, 67, 14, 8, 8)πCALL BOX(52, 11, 66, 13, 1, 15)ππCOLOR 1, 15πLOCATE 8, 18: PRINT "LEVEL 1"πLOCATE 8, 37: PRINT "LEVEL 3"π'LOCATE 8, 57: PRINT "CUSTOM"πLOCATE 15, 18: PRINT "LEVEL 2"πLOCATE 15, 37: PRINT "LEVEL 4"πLOCATE 12, 56: PRINT "CANCEL"ππDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 15 AND HOR% <= 29 THENπNUMOFBLOCKS = 10: NEWGAMECANCELLED = 0: EXIT DOπEXIT DOπEND IFπIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 34 AND HOR% <= 47 THENπNUMOFBLOCKS = 20: NEWGAMECANCELLED = 0: EXIT DOπEND IFπ'IF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 53 AND HOR% <= 66 THENπ'CALL CUSTOMBOXπ'END IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 15 AND HOR% <= 29 THENπNUMOFBLOCKS = 15: NEWGAMECANCELLED = 0: EXIT DOπEND IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 34 AND HOR% <= 47 THENπNUMOFBLOCKS = 25: NEWGAMECANCELLED = 0: EXIT DOπEND IFπIF VERT% >= 11 AND VERT% <= 13 AND HOR% >= 52 AND HOR% <= 66 THENπNEWGAMECANCELLED = 1πEXIT DOπEND IFπEND IFπLOOPπPCOPY 4, 3πSCREEN , , 3, 3πDELAY (10000)πEND SUBππSUB MENUπCALL MOUSEOFFπPCOPY 1, 2: PCOPY 2, 3πSCREEN , , 3, 2πCALL DBLBOX(10, 5, 70, 20, 2, 15)πCOLOR 8, 8:πFOR I = 11 TO 71πa = SCREEN(21, I)πLOCATE 21, I: PRINT CHR$(a)πNEXT IπFOR J = 6 TO 20πa = SCREEN(J, 71)πLOCATE J, 71: PRINT CHR$(a)πNEXT JππFOR X = 15 TO 58 STEP 19πFOR Y = 7 TO 14 STEP 7πCALL BOX(X + 1, Y + 1, X + 14, Y + 3, 8, 8)πCALL BOX(X, Y, X + 13, Y + 2, 1, 14)πNEXT YπNEXT XπSCREEN , , 3, 3ππCOLOR 15, 14πLOCATE 8, 18: PRINT "NEW GAME"πLOCATE 8, 37: PRINT "CONTINUE"πLOCATE 8, 58: PRINT "HELP"πLOCATE 15, 19: PRINT "ABOUT"πLOCATE 15, 36: PRINT "BEST TIMES"πLOCATE 15, 58: PRINT "EXIT"ππCALL MOUSEONππDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 15 AND HOR% <= 29 THENπCALL LEVELSπIF NEWGAMECANCELLED = 0 THENπNEWGAME = 1πEXIT DOπEND IFπEND IFππIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 34 AND HOR% <= 47 THENπIF WON = 1 OR LOST = 1 OR NUMOFBLOCKS = 0 THENπBEEPπELSE EXIT DOπEND IFππEND IFπIF VERT% >= 7 AND VERT% <= 9 AND HOR% >= 53 AND HOR% <= 66 THENπCALL HELPπEND IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 15 AND HOR% <= 29 THENπCALL ABOUTπEND IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 34 AND HOR% <= 47 THENπCALL SHOWHISCOREπEND IFπIF VERT% >= 14 AND VERT% <= 16 AND HOR% >= 53 AND HOR% <= 66 THENπCOLOR 10, 0πCALL MOUSEOFF: CLS : SYSTEMπEND IFπEND IFπLOOPππDELAY (10000)πPCOPY 2, 1πSCREEN , , 1, 1ππEND SUBππFUNCTION MouseInstalled%π DEF SEG = 0π MouseSeg& = 256& * PEEK(207) + PEEK(206)π MouseOfs& = 256& * PEEK(205) + PEEK(204) + 2π DEF SEG = MouseSeg&π IF (MouseSeg& = 0 AND MouseOfs& = 0) OR PEEK(MouseOfs&) = 207 THENπ MouseInstalled% = 0π EXIT FUNCTIONπ ELSEπ MouseInstalled% = -1π END IFπ DEF SEGπ RegX.ax = 0π CALL INTERRUPTX(&H33, RegX, RegX)π IF RegX.ax = -1 THENπ MouseInstalled% = -1π ELSEπ MouseInstalled% = 0π END IFπEND FUNCTIONππSUB MouseLocate (Xpos%, Ypos%)π RegX.dx = (Xpos% * 8) - 1π RegX.cx = (Ypos% * 8) - 1π RegX.ax = 4π CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MOUSEOFFπ RegX.ax = 2π CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MOUSEONπ RegX.ax = 1π CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseSetHor (Min%, Max%)π RegX.cx = (Min% * 8) - 1π RegX.dx = (Max% * 8) - 1π RegX.ax = 7π CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseSetVert (Min%, Max%)π RegX.cx = (Min% * 8) - 1π RegX.dx = (Max% * 8) - 1π RegX.ax = 8π CALL INTERRUPTX(&H33, RegX, RegX)πEND SUBππSUB MouseStatus (VERT%, HOR%, MBUTTONS$)π RegX.ax = 3π CALL INTERRUPTX(&H33, RegX, RegX)π VERT% = (RegX.dx / 8) + 1π HOR% = (RegX.cx / 8) + 1π SELECT CASE RegX.bxπ CASE 0π MBUTTONS$ = " "π CASE 1π MBUTTONS$ = "L"π CASE 2π MBUTTONS$ = "R"π CASE 3π MBUTTONS$ = "LR"π CASE 4π MBUTTONS$ = "C"π END SELECTπEND SUBππSUB RESETSCORESπOPEN "HISCORE.DAT" FOR RANDOM AS #1πPLAYER.FNAME = "Anonymous"πPLAYER.time = "9999999999"πPLAYER.DATE = "-"ππFOR I = 1 TO 4πPUT #1, I, PLAYERπNEXT IπCLOSE #1ππEND SUBππSUB SHOWHISCOREπCALL MOUSEOFFπPCOPY 3, 4πCALL MOUSEONπCALL DBLBOX(1, 1, 80, 24, 8, 15)πFOR X = 3 TO 63 STEP 19πFOR Y = 4 TO 17 STEP 4πCALL BOX(X + 1, Y + 1, X + 17, Y + 3, 2, 1)πCALL BOX(X, Y, X + 16, Y + 2, 1, 15)πNEXT YπNEXT XπCALL BOX(21, 21, 31, 23, 2, 1)πCALL BOX(20, 20, 30, 22, 1, 15)πCALL BOX(36, 21, 56, 23, 2, 1)πCALL BOX(35, 20, 55, 22, 1, 15)ππOPEN "HISCORE.DAT" FOR RANDOM AS #1πIF LOF(1) = 0 THENπCLOSE #1: CALL RESETSCORESπOPEN "HISCORE.DAT" FOR RANDOM AS #1πEND IFππCOLOR 0, 15πFOR I = 1 TO 4πGET #1, I, PLAYERπLOCATE I * 4 + 1, 8: PRINT "LEVEL :"; IπLOCATE I * 4 + 1, INT(31 - .5 * (LEN(RTRIM$(PLAYER.FNAME)))): PRINT RTRIM$(PLAYER.FNAME)πLOCATE I * 4 + 1, INT(50 - .5 * (LEN(RTRIM$((PLAYER.time))))): PRINT RTRIM$(PLAYER.time)πLOCATE I * 4 + 1, INT(69 - .5 * (LEN(RTRIM$((PLAYER.DATE))))): PRINT RTRIM$(PLAYER.DATE)πNEXT IπCLOSE #1ππLOCATE 21, 24: PRINT "OK"πLOCATE 21, 39: PRINT "RESET SCORES"ππCOLOR 8, 15πLOCATE 2, 35: PRINT "BEST TIMES"ππLOCATE 3, 8: PRINT "LEVEL"πLOCATE 3, 29: PRINT "NAME"πLOCATE 3, 45: PRINT "TIME (sec)"πLOCATE 3, 67: PRINT "DATE"ππDOπCALL MouseStatus(VERT%, HOR%, MBUTTONS$)πIF MBUTTONS$ = "L" THENπIF VERT% >= 20 AND VERT% <= 22 THENπIF HOR% >= 20 AND HOR% <= 30 THENπEXIT DOπEND IFπIF HOR% >= 35 AND HOR% <= 55 THENπCALL RESETSCORESπEXIT DOπEND IFπEND IFπEND IFπLOOPππPCOPY 4, 3πSCREEN , , 3, 3π'DELAY (10000)ππEND SUBππSUB SHOWMINESπBEEPπFOR I = 1 TO NUMOFBLOCKSπFOR J = 1 TO 7πIF BLOCK(I, J).CONTENT = CHR$(21) THENπCOLOR 10, 2πX = BLOCK(I, J).STARTX: Y = BLOCK(I, J).STARTYπCALL DBLBOX(X, Y, X + 2, Y + 2, 12, 1)πLOCATE Y + 1, X + 1: PRINT BLOCK(I, J).CONTENTπEND IFπNEXT JπNEXT IπCOLOR 10, 0πEND SUBππSUB STARTπCLSπFOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(219); : NEXT J: NEXT IπFOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(178); : NEXT J: NEXT IπFOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(177); : NEXT J: NEXT IπFOR I = 1 TO 80: FOR J = 1 TO 6: PRINT CHR$(176); : NEXT J: NEXT IππCALL DBLBOX(20, 8, 58, 17, 1, 11)πCOLOR 8, 0:πFOR I = 21 TO 59πa = SCREEN(18, I)πLOCATE 18, I: PRINT CHR$(a)πNEXT IπFOR J = 9 TO 17πa = SCREEN(J, 59)πLOCATE J, 59: PRINT CHR$(a)πNEXT JππFOR I = 23 TO 53 STEP 3πCALL BOX(I, 10, I + 2, 12, 11, 1)πNEXT IπTITLE$ = "MINESWEEPER"πCOLOR 9, 1πFOR I = 1 TO 11πa$ = MID$(TITLE$, I, 1)πLOCATE 11, I * 3 + 21: PRINT a$πNEXT IπCOLOR 1, 11πLOCATE 13, 35: PRINT "For DOS"πIF NOT MouseInstalled% THENπLOCATE 15, 22: PRINT " Sorry , system must have a mouse !"πSLEEP (2)πCOLOR 1, 0: CLS : SYSTEMπELSEπLOCATE 15, 29: PRINT "Mouse found and reset ."πCALL MOUSEONπEND IFππEND SUBππSUB VLINE (Y1, Y2, X)ππ'DETERMINE GREATER Y CO-ORDINATEπIF Y1 > Y2 THENπGREATER = Y1: LESSER = Y2πELSEπGREATER = Y2: LESSER = Y1πEND IFπFOR I = LESSER TO GREATERπLOCATE I, X: PRINT CHR$(179)πNEXT IππEND SUBπAndy J. Golden STAR TREK COMMUNICATOR PIN YHBV44@prodigy.com 06-14-96 (00:00) QB, QBasic, PDS 55 1847 STPIN.BAS ' Star Trek: The Next Generation - Communicator Pin.π' BASIC graphics program by Andy Golden - June 14, 1996.π' This program was not created, approved, licensed,π' or endorsed by any entity involved in creating orπ' producing the Star Trek(R) television series orπ' films.ππdim y(5)πscreen 1πwindow (-10,-10)-(10,10)πfor z=1 to 5π for x=-10 to 10 step .1π y(1)=-x^2+8π if x>=0 then y(2)=-x^1.5-1 else y(2)=11π if x<=0 then y(3)=-abs(x)^1.5-1 else y(3)=11π y(4)=sqr(49-49*(x^2)/100)-1π y(5)=-y(4)-2π pset(x,y(z))π nextπnextππ' I originally wrote this program on my TI-85 graphingπ' calculator in Algebra II class back some time aroundπ' February 1996. Then on June 14, 1996, I decided toπ' translate it to work with PowerBASIC and QBASIC andπ' other BASICs for an IBM compatible PC. The resultπ' is the program above. The equations y(2) and y(3)π' had to be modified because BASIC just can't handleπ' imaginary numbers; so I used a cheesy IF/THEN/ELSEπ' statement to eliminate them because I just don't feelπ' like setting here for a few weeks writing all my ownπ' mathematical subroutines and functions to handleπ' imaginary numbers. Maybe some other time. :-)π'π' Here is what all the equations do:π' y(1) Draws an archπ' y(2) Draws right leg of communicator pinπ' y(3) Draws left leg of pinπ' y(4) Draws top half of ellipseπ' y(5) Draws bottom half of ellipseπ'π' Here is the original program for the TI-85:π'π' FnOff Replace the word Square Rootπ' Func in equation y4 with theπ' AxesOff square root symbol.π' ClLCDπ' ClDrwπ' Zstdπ' y1=-x^2+8π' y2=-x^1.5-1π' y3=-((-x)^1.5)-1π' y4=Square Root (49-49x^2/100)-1π' y5=-y4-2π' FnOnπSteven Sensarn SCROLLING CELL MAP txs53132@bayou.uh.edu 07-08-96 (00:00) QB, QBasic, PDS 50 3227 CELLS.BAS DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"CELLS.ZIP",4^6:Z&=2141:?STRING$(50,177);πU"%up()%9%%%I-%aaf_EBa&yjm%%%%%(%%%.%%%%hj%qqxS[ufqf,a*2%%V-(b8ilπU"lM.91aWahu5m+NuaxMK$b_%4._(*I[KYi/i6^0'_uInRif-/_61DT.7uM^Sfd\%πU"x6^Rfg*mi,'l'u%p()9%%%%-g%da_jEE1W'QJ'%(%K7%%%.%%%%hjq%qxSiRfyfπU"%2,FREj1&Yqu7Xx+DN(JG'G7E=UE%4M0%4rL)E+TFf2ICX5f(Z(B$/0.1J_0.AOπU"'U'_ISx9FBYN%*YLsC?HK34n2(<M#?&KYI%Bg-tQJ,V1eS+.l[pu.FZm>U4W60EπU"I#e9\,B-W4ei8&_b$)gdb09Ri\01T$d^fHXgYNVO>^M<i&r%(W,,('1KlUuX'd_πU"hYL7D5;E?01S&tXhn[5lP$I^wWSLQRbzjV%(EVr%i5RC4NDiW5R6=\W\Dt,P*%[πU"-51DBKRp].6%[fkOYCkk$PDq_Y%,M*t#AFTj]?DaBPzq*<mE%q0+Q^63?T%c\a%πU"D'8tp8[TYf'udaH^<O#-)0p2mjcFm]D06)q#e::JB<stO[q^+POnI?mERQ+IgndπU"&-1,fV%Y&f;oUo4<O+rI.<ki/4pN(eOOE0SVOKXwXV1R4Qp\Ck)pT]r1i-11PWMπU"mX0x[FQ/]kZm#E?U?D=P,&#A4$+0OR0:28/I.zxdpHxpV_b)z8k4Ro.6o[[l?WvπU">.n9Z%NH3S89Hhab%4XNmz;J*2(kc4Q-<OsWv0n5KtZTS+FQ1Odm^uJlb$*izp=πU"=p%-kJd<XTW&S,FvWF11MQlwY_:o+_]P$9Ox%lR$xzaMQ3oIN3x:LcO4&K2\,\VπU"c>FbB=>nvtR?/r=0?f'xh1?'^v:0)tBT-rIX0ko(zeNDe#oxBk7(aM%u%p()9%%πU"%%-j%6a_OETZc+19)%+%n9%%%.%%%%hjq%qxSgRfxV';<>\[+1wCEWxPAYrN=+-πU"OsP:=f1CoQIoHk2j#/A*BpRn>ZhtvnIloM$[A$n4#$1=JRT[BVAsmoqC#?d3gNVπU";,AOR8A2iAhW;nR\3(,uui4MEZHqM_+fQM$0g&DhmY*FaymiWr$)n_pR\P#FaM$πU"4L+\n;??j2v\U3C,MA4#7yIM:A=Ov#+tUj6<.[J(0d%ohPtk?]T3r[2)9*6oA:bπU"Vu:.KI9D*F<[6IG$Mp\(#6j5a-Hk_[wL9Cre1N*B/lB4Vdk7,-i49[4.9&z0Gs/πU"[&*syh:M]wQW*U-H.12?YG(UcZ9.Q*ahRV+XE<]ROXZMH,Uc$is:=ec*J+3D?2IπU"Q3E#2J.FwM_P'h/B;?,iE$GE2-DI)?I;>BP_4ghBMnHIS?(SJVMyF2d0^;5U2UhπU"8z>v7PS0nNYW;hYa>c&NP/$-wXl'+\BXWw-4SmMQ=BN^XwXT;7]L,W;71L,hnA1πU"CPFt1TgvmK;M[(=eD;jpsvLJe?u<F#H21&%m6lETRG]UGA,L^:Uyt(LKhp-bu'pπU",CQ-pH5)hP7)b#N.bbX;i)hT#0n$<.W7KfPODCL1h^V:s&7oq:g'jXxpQm\DQm/πU"AN,b_l)56Z9&*E(^iK;]047UFvCK9q-wON6A5^*g?%m7>42T$:6>B(Z^mV5ccl0πU">2vm]2BN9YGW=7ZNp$)C\T*PY=.xwe^fgo__h=pE#Mt^mEXD]EI/9j6d(_EZPR*πU"j\5o?.dPw#V],okK#m^_G8#j[CzrShBA)j3y,Mjh^Y86ioTOw;ro8;AvSFG-Mq=πU"t51?+3;]sTMS/=G5&mjscp&fP-*Z2BoWsX3vs^eGrMrC;sa0zWcJM+jh+$Yh'V.πU"gT48t?CPK<(6OrK\jNHJmXWOnkduu2VNbsn38+[7G&mp1nFXMpPITO2jLjdf]:XπU"rChPH8Etp-&#fChcI#AQJBxCEv&bLHdbcS0KOs*tl,FYvsEi/s[F]V4\G(pXnSFπU"a8UNZc5NJH;+qF.6-ksetbK+J&nO(oD73i:_8UD?d>lZva^s/6Cxn.L2l2=7bJ6πU"znGxcSyl,EFOjG1AOLQhORacMc4?*pR=Mw0c3mqB\2XS76N*pecv;f+.yuBPBMuπU"3b.%T_d:75C=yDf#UIR6pxkk9g4vd)6_m$eq<svWZ?Q:FgG^nTtT8FoKTt,oAdxπU"gYs8w>rA.xa>sXGHDF4vEXT4<0PvdPN6o$$r^&:OdbIWL3DIbt9&m<'D\E?uLu0πU"lr>Ka\j-G.HpL&imoONJZQ-oU.86MElI:_1Mmr2oa[cZp4D_TCtrwQ3Ya7R4+fyπU"nV<s$=']'yP<J:KP99j$5DQfE]pl06a92$-M%I8UYIaKl]VfJKU+DX(rnFDbERTπU"IZpgAd4KN$m:WI+h+]\Z<7=Z2EC:CiT[TWmqMYDh8jrYND^**/cVev9JI/p-^6'πU"h.FB\i,m:qT*qJ:=Kw$;GJ]_Lb0h.$>>#,uGHXfo*#nduja?qC*e6NdZ>,ia2ICπU"Z3BI:QcL8x2k/Oq(SAwCjT?Om2Xptq2AX]yieOr/Wo:wUS'Cdup%&'9%%9%%%I-πU"%aaf_EBa&yjm%%%%%(%%%.%%%%%%%%%%%%E%%%%%%%%%hjqq%xSuf%qup&%'9%9πU"%%%%-g%da_jEE1W'QJ'%(%K7%%%.%%%%%%%%%%%E#%%%>%%%%h%jqqx%Sify%upπU"&'%9%9%%%%-%<6a_E3TZc1'9)%%'n9%%%.%%%%%%%%%&%E%7%%4'%%%hj%qqxS%πU"gfxu%p*+%%%%%(#%(%t#%%%q%,%%%%%πEND SUBπCLOSE:IF S=28AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπScott Tuttle SCREEN ART/SAVER Scott.Tuttle@newriver.net 07-08-96 (20:23) QB, QBasic, PDS 198 6816 ARTS.BAS 'Screen Art/Saver inspired by John Wantlands Black Holeπ'but for faaster computers.ππRANDOMIZE TIMERπDEFINT A-ZππSCREEN 13 'πmaxx = 320 'screen dimensionsπmaxy = 199 'can be set for different modesππFOR t = 1 TO 255 ' sets palette to shades of whiteπb = INT(63 / 255 * t)πOUT &H3C6, 255πOUT &H3C8, 256 - tπOUT &H3C9, bπOUT &H3C9, bπOUT &H3C9, bπNEXT tππ 'rem these out for QBASICπIF COMMAND$ <> "" THEN 'check command lineπ num = VAL(COMMAND$) 'for number of pixelsπ IF num < 10 THEN num = 10 π END IFπIF COMMAND$ = "" THEN num = 100 'to hereππDIM x!(num), y!(num), dx!(num), dy!(num)πππcx = maxx \ 2 'center coor for current screenπcy = maxy \ 2πrr = 10 'diameter of black holeπFOR t = 1 TO num 'init coors and speedπx!(t) = RND * maxxπy!(t) = RND * maxyπdx!(t) = 0πdy!(t) = 0πNEXT tππt1 = 1 'some constants-for speedπt2 = 2πt5 = 5πt4 = 4πt6 = 6ππg! = .2 'gravity factorππDOππFOR t = t1 TO numπPRESET (x!(t), y!(t)) 'erase old pixelπdx = cx - x!(t) 'compute distanceπdy = cy - y!(t)πr = SQR(dx ^ t2 + dy ^ t2) + t1π 'play with the .98 for differentπ 'effectsπdx!(t) = dx!(t) * .98 + (g! / r) * dx 'accel * orbitdegradation + forceπdy!(t) = dy!(t) * .98 + (g! / r) * dy 'dittoπx!(t) = x!(t) + dx!(t) 'calc new positionπy!(t) = y!(t) + dy!(t)πPSET (x!(t), y!(t)), r 'draw new pixelπIF r < rr THEN 'did it go into the hole?π PSET (x!(t), y!(t)), 0 'erase itπ x!(t) = RND * (cx \ t5) 'create new pixelπ y!(t) = cy + RND * (cy \ t4)π dy!(t) = t6π dx!(t) = t6π END IFπNEXTπIF RND > .95 THEN g! = RND - .05 'random the gravity-nice visual effectπLOOP UNTIL INKEY$ <> ""ππSCREEN 0 'exit w/credits to me :)πWIDTH 80πCOLOR 14πPRINT "⌠ ┬ "πPRINT "⌡cott │uttle '96"πCOLOR 7π______________________________cut here_____________________________________ππ'Screen art that draws water fountains.ππSCREEN 13π ' you can specify the number ofπ 'pixels on the command lineπ 'ex: GRXFOUNT 1000π 'for 1000 pixelsππ'rem this for qbasicπIF COMMAND$ <> "" THEN 'checks to see if there's a numberπ num = VAL(COMMAND$) 'on the command lineπ END IFπ' to hereππIF num = 0 THEN num = 100 'if not-its thisπIF num > 2000 THEN num = 2000 'limit on numππDIM x(num), y(num), dx(num), dy(num) 'x-coor,y-coor,dx&dy speedsπDEFINT B, T, Z 'pallette & countersπRANDOMIZE TIMERππg = .1 ' gravityπscale1 = .627451 'scaler 1πt160 = 160 'constant intπpi = 3.1415 'pi-duhh!πt199 = 199 'bottom of screen constant intπzero% = 0πone% = 1πtwo% = 2πt255 = 255πmode% = 1ππDO 'color schemeπbf = INT(RND * two%)πrf = INT(RND * two%)πgf = INT(RND * two%)πLOOP UNTIL bf + gf + rf <> zero% 'no black-outsππrand: 'randomizes and resetsπCLSπdyscale = (RND * -4) - 3 'rnd dyscaleπdxscale = (RND * two%) + one% 'rnd dxscaleπda = RND * .01 'init-angle speedπa = RND * pi 'init angleπFOR t = one% TO num 'sets all coors and speedsπPSET (x(t), y(t)), zero%πy(t) = t199πx(t) = t160πdx(t) = RND * 5 - 2.5πdy(t) = -RND * 6πNEXTππ'πDO 'main loopππFOR z = num TO one% STEP -1 'pixel loop for colorππ FOR t = one% TO num 'loop to calc&drawπ LINE (t160, t199)-(x(t), y(t)), zero% 'erase oldπ x(t) = x(t) + dx(t) 'compute new coorπ y(t) = y(t) + dy(t)π dy(t) = dy(t) + gπ IF y(t) > t199 THEN 'Did pixel go through floor?π x(t) = t160 'reset single pixπ y(t) = t199 ' with new coorsπ IF mode% = -1 THENπ dx(t) = RND * 4 - 2π dy(t) = -RND * 6π ELSEπ dy(t) = SIN(a) * dyscale 'and angle speedsπ dx(t) = COS(a) * dxscale 'constants scale speedsπ a = a + da 'move angleπ 'is it OK? reverse if notπ IF a > pi OR a < zero% THEN da = -daπ END IFπ END IFπ 'draw new pixel with color based on distance from centerπ LINE (t160, t199)-(x(t), y(t)), scale1 * (t160 - ABS(t160 - x(t)))π NEXT tππIF INKEY$ <> "" THEN GOTO quit 'key checkπb = INT((53 / num) * z) + 10 'brightness-scaled to num pixelsπIF z > t255 THEN z = t255π πred = rf * bπgreen = gf * bπblue = bf * bπOUT &H3C6, t255 'ready to change paletteπOUT &H3C8, z 'colorπOUT &H3C9, red 'red valπOUT &H3C9, green 'green valπOUT &H3C9, blue 'blue valππNEXT zππda = da + RND * .01 'rnd the angle speedsπIF da < -.1 THEN da = -.1 'see if new speed okπIF da > .1 THEN da = .1 'dittoππmode% = -mode%π 'another palette changeπ DOπ bf = INT(RND * two%)π rf = INT(RND * two%)π gf = INT(RND * two%)π LOOP UNTIL bf + gf + rf <> zero%ππdyscale = RND * -2.7 - 3.5 'rnd dyscaleπdxscale = RND * one% + two% 'rnd dxscaleπLOOPππquit:πSCREEN 0πWIDTH 80πCOLOR 14πPRINT "⌠ ┬ "πPRINT "⌡cott │uttle '96"πCOLOR 7πErika Schulze MODE-X MANDELBROT SET 100775.2275@CompuServe.com 07-09-96 (19:15) PB 476 31377 MANDEL.BAS ' To extract MANDEL.ZIP, please load/run under PowerBASICπDEFINT A-Z: SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"MANDEL.ZIP",4^6:Z&=23240:?STRING$(50,177);πU"%up()%9%%%[-%n6KbE\g:D/K;d%%0W%%%-%%%%rf%siSfRxrf,;:>Tm>evE%'r4πU"*QJI$b%A5moqJ8#mT7in,>bCSfe'G+=)12YsR(s7wrLwXk.H8%<(+QNRv;]l=>CπU"/_8*SvSd#6cWBTmDgKdT(hPHfsIY(k&^<l?PaH2crPZTZaL^<.>:7B9^MHc2p&(πU"=]6hhT-=8:t2ns#?GxEAF4W\?XiDD-RQUSu8dy;[c*xUFZN2xi_.(T>vVTJsstWπU"'XG25blht^ENLjLWjDgd-lH'_$DCS&D7\r,ZaSCEVWLfLY&N0JOB\Lv)q^J#=47πU"Z223YEkvtmRcfK:E6(K#kOI4-(RncVX1s4P4l=U%*.8UHjxJA-W(t<)lg:C*gXAπU"0ERjy7]T0v+>mYAp'('E%^XUAlbiYnG'V6bDXKq^.bCt(Cq.r6(35nwnVrm6U_LπU"rC,':gjR94F<k4b&q<\BmKSQ7MnuY]C[*C4[^Ix;q6dQsTJI,q&NRfbcqG5EqB8πU"tpfcP&gky%,lx<V.jRL)Z'<+n;VKWL:Cg*-<ISqjob>uZ3*jZ4EfIYVMueCHvGoπU"%_R&j9v7m*JQARVlMIqCb^0*sm1rVb/lwAW9;tX^jW+DIK_5?3biQ7_BHc$^#>6πU"P'$((Kn=T#0ZTbM.)#]<0%dzQJ^d68fbLwEDynuR$JQr5$Io_C4_j>v5c[RzrxSπU"YZ+q/5j3b&27&;Q8dc>d-.;C</WbdnhSJ\l;#2E]gl,4g,62)>a'8+TPYW#y<E)πU"9;sr8VYw=$^4AetjSZUmaGi%$;.JR#L2p,('+8;46(,)8M/ZbfLa5m'X7Eoo[9gπU".88saCHQ]je.HW#?Biy):QO7IHT;oq0>'n7ePzqIt&8WxYTJtF+0eta*eM>6bH7πU"<QcA\Y,imtQ,6$/k7SWrii\-3LqXPB,T4f0#DXk#/:JMLb,,#Nb3nL'Z=b%r?k^πU"&ulb0BY1A(r\E(AY-U<f0*J<.BSmXQlrIqT3;JBnK>n_th4mPtt7*)a9oE<-W+jπU".naPQSsZRdU.l([oYAu8ATbUWAoH1qjx1>dN(hkH\-Ag0FZENt&,]gEp+.ACO9oπU"+g8mLvmdMPx<]'?mj<3q$<=6\.bdSfQ[5g''J*Y+Vrm=24gtd8fMI1PC*/-/>>fπU"ed5<fMFTDa-G=Cm)Rxx4uMzPXd?>9-r-4s^YqVoP9DP4u\VH+vC_y$4EDr9i?^EπU"#P=i*H+vhkgbcQ$MkQ>7HmO6=Ekzsd$_5-s2U<OP%4zNP8ke:vms.,)tnybQDb+πU"_WZg[;+CRd(K#vQ13$?f/e-+<W[kcTP+\D6\].c;&_[6Goc_;\%nxrQ/vcyc47AπU",QCq<WC^1Mb2CegW,umOm^'r*pq$1ZJT-CHHDs]IA[4,[x5'-AK7tOWr(7<%IZ,πU"nT=qYP8GNGR_(X%+TSLA>SFZXMU%nMhNx_?882]tNl#dElZ3%[N;=KN-TlGnfTXπU"G$xGbrd,YK%/.>E[kJlV\k]?J&ok>v\b1'?SsSqn]?Pr^JlMVpBl*xT+OPM7K\iπU"#PTu1.vPf$TN4Q5Yh_n<=mqX3j7,9kD<UDCXs4pujSiEH8W2bWBqvJ$cLxP0CStπU"'wyovPG0FBt$3#t],43N]]#AK4Z<wr,EAN])EN;v5*fi\WMu44#/Ac,+%2&,M'ZπU"l;1e'5e6xPB-UMM:Q+o\0DihyIZ:h'#07Eu201=l%<e/?DG=v#WCObGPbi2%PPHπU"DRnBBP$e%9Rr$Zu33g48rzKZ_4]ZSDhRY9Ahh%L>[prC[NQQB,]q:c>R]'%dv/+πU"kL^s7T3?OU:cA(y&B.*ev%/3;wbuF9gA7v[LG)RN[%fFY2J#-9<]R]#.5i]nDeyπU"D(4<vY*C^&s6dj>Kx;-?CCBfQ%dC5^>/erd$9N+fOVPgHJ&A*jHV2>(2*tt+lrAπU"LY*)\ip(7;K->>r2%2A$gvL#*80MM;V:vM&Xw4/mgwK'dRLc,2.hHg=EAA1ddg?πU"AtNlr>qq_)^WN#r_k3b-TY%ccuF%r3umHlG/8DMwgigAs_EKRCTsMwfE&[murmBπU"#zmJ:Pe.g-KPM^$%*z+9W&,TIvmJ9t\F/v[tum6aicJKeLosG('8-0AsVI_M]FZπU"((dae?AiB)a,zMlH/rz7W_l-KnOWb?h3](LF'b,OI_L$qce)mio1Wxfn06qIEShπU"Y3j=qcdmTc_Kg-u*TJ9n?b$mRJv$V8s7cNM:s-aHn?bKg?8Kpl\]w01?xxINnp$πU"858hZ24e'rN;cv>['\rN$.UGKJmUstahS8:Gu64(0Ty-jFnAY$Ts^SVN%<]D^m:πU"QQVCCA%UddP>)aHDxJjIE/,s44^n+U]*13(p?hjbLArSukCIvgqT0Mt>Dc+/^LUπU"F*vk9hhO[j<t'#lPAQrhX&a77N7_L?oKmrA$Udv3QVb\:jQuI<Wk7Nj7]6N0(&JπU"xsIAHC<?O6N47]vz;\U6NO7_v&5pajGUfMSG+4J\jYQu-z+c+\jYQu-z+c+\jYQπU"u-6::Y7Nj7_v6+?)\jZ;u%]cEW9RVhnO-2MAs2QkLa$IEdzr*.$Ed\<>.k&BMHfπU"hMAsF&$Ed^HK[m_JnZa#oB+rBq$K8TIEdXv(6$Ed(.AFELfM1smRG.w&BMGf,MSπU"W7*]vJHLfM)u>SMkxmi3.j,lFNjG9\$jpxYM?/F[v9a.tt,66\UE%d>\#aIAt?]πU"F+.k;b#,f6;wBFrRSv$h$SSv_v;8_)v;xD0Xjsc<72]6ph9\4jJ'uO\N7I04.kbπU"H(^fkEUdVM-nR)rB2F#\)fr^s\h=_)x1NAM)-tHH.a.dtRFK%d4hj)M/Y_)w3+mπU"7kH_'NSS$4G)d[tC\2Lr_ne(90lE%d>\#PsONY_m0)t4t?t?j.kbd^5]A<-u-IIπU"'Etlg6;ukm#mRd*1m<KLUmeD[6.jlEpBUM?MFQ3ikE%\hGq'#:0\$jxYYM?FC[vπU"9x5\h;sLNA>Kr($)x\kmmQ&N_77NoneS-Mkxi%_Ed^5a($(ck,k+hDF/v3B$[ppπU"3k8HZStVPrlFCF7+.tt-CF+.ottCFR+.kb3dHmD[^EdF[H..k5b]TGpwj80t_)xπU"m7IIedp^a^>+3ed>>a$)3Bed^a$rH,]M6\3yTk-G^:a1(fl;r$#2A<])BrnW,5pπU";B)rkb$>mZ7GX]#77O)nB..-dHH.5x^604.lbH]R?B:cu]m/'glEdg^aBbO-]6\πU",3ua'urB1R.EfMWA=[m_2n[j2j7G^__<jSE[tpg;'uApmVgn'SZMk,TYSrB$u%CπU"Z;KnJ]3tzb;ngJ]3*Z<NOf0=_g0fdt^O$:9I%adrS_OmQNI0-3%Hc.wx]950ttnπU"&g;wABQF0*x8nm[Rdj]:Vk8XLI.r2g]Nn0GFjVk$8BI\uK*/wXNgp2g]Nn,\)JlπU"c<vvY>;]0x^A6Zz]YSrB:\yA.l3L$_U(d,..*lBGFHnu9$HSqs_CqRB:]\$fkZNπU"M?F_Q3/in'#X>+?ni#6XRkwns[7,C^tmL_Kn-A?6j6k6;wBGpF0xbRomQN[_7wHπU"[t6.l8bHR?Lr/M]6S4G'*lbH>&fKUd=lfvcGPr^15:=$Uddl<H:UPr^q1+[AQ6nπU"H-rNk;w\BIFn*$^iI'edb.a.lxgFLEtMLk[\L4/lbHHR3t0DMAI2TV9_v/Cc=/WπU"lbS:&_Udr/Ec]HV0MK#I\mgnt5te9O9OnmVSSnvdPF0vL^a_))MYmtV*n0SsZk-πU"nJHp'Fgt*n0d)SHScs5JiuLLO$ERkwso/cH_ncG.n/H[v9a.$l'S38G^[K77G&^πU"a..0$lB.5x^60a.tt7^$g'mY/xB$nKZ.$e^-areH4]hk5t+rLqNMBmGEZq*GFVlπU"Q;jl4\KZwdmdjGH-msxi?;umIXIEHXtSMk,qTSrBM$;\5mUdVopSm:uT]m?tp>kπU"84HfvcRTvLH07^wddFjHURTvL^5;RSvL04gRHu$)xm7IIed\677oAn0.x,^hGwXπU"DXjwk'&A'b^h=BP98BL)Kn[1thd\4Y?>D++DXb&;x^hXg&x^h70&2d$7BIENHTSπU"SKr^b_%Udb.Px^vWY+9uk</Fj']_Ll+hD.7(2.1BoM$?Kn?/pt'NoncjR27on)cπU"j27ronL/h6'7H:DX$6=;slldGwNwmmicHpDXA6N$^9s6ouJ0u2ps3s?Rrsnt*_$πU"ZgL5rmYQiXsbZ2eVJmk\8pdhCfNTYF(rSuu;k/=EmQsi:u)jL$lppy%,,ucJCtIπU"l.?u;OSZv[<XJPDY-DoA:pp7*?P>%xn5mPTLntu%EuDedPKG:IB-cQE^2Xbb=wUπU"$P+c$my-kRMo4iQr6WYAyXTNf4ierH8q?0M;R+=eLe6gYDNiQa>?_H='\CLVfrXπU"3.D2N$%E\:=tvwo]Y[up[m1$VUsQj,wW^M>8SXB80Vke2nC;&v]3C[[1tjEjN-^πU"mmv4?'zVu518Pd(V(qea'C81q=L$H<Qf:?uIx'Er8mM:J&e<(Red%/b>#nk.g/_πU"p$3+)D/9c*,kHRK[#k,g,Y/DDPRr2:r8[:FbnMq'k];gUTBLPN]3DglFdZfrtFaπU"'O4-(jdc6>\:Vkv$&V&F+E*(:OTaL_]w5fI+cEsIx/;LP;=Hw%uKMEbLs[_HCIbπU"*l5r3G_,EBm_2Z&bGkTWw]OMcgXiq$ofwv+EbE.9NKur)hp]2NkW7l7UK7vNP,nπU".U1.pQoWoDh51;FT3**h9Qvibs-6Q,1R<tJzZO&Ece_M^'$\qy>XoWb?#$=+rtdπU"IbfoB>rDQ,se6r>RGd:V>jB5#FwtGZTY'3^(Y$.&alcrTcuIrw%L,_3/+ojsHy8πU"Oa<247hymRQB;1XIypikVkLmbprS'+[A.km\LyaYb+47Fl&[KsI:4T=\\wZx2?bπU"/$+=03?.yr7IB:VuBfIa)lKJ:Y>PsI]YTUnW#XeZGOOgfOa5P^Z#*$z1mkDH;P1πU"*ZE;jQK^hHqdTgrkmO'%0MQ,>*9cT9HmIiL<t.=O/eb$5tQMVTDiu3:5=>sZJtWπU"#ZA'4E39_Sfn+Jjsf>za&lp%aYG[ROxnyP;/i+n*\fNT%fIS73*3Fc$%-9gzz#*πU"7j7j5P>2*t#vO*SOX5_v#>tFnu^9&CS.R\V5(X,eVij7B2[&-t;[=%8:(z\;<q9πU"*X4Eq9tujr;2K_Oqg9_Y+&sDH3]rDk;=f??NSLPdBZ0<x$7I'-3<)(3VIBwYTGZπU"7da;(b7&JBu8a]mMoex5;vEOe-bJbXK.BgN/&gL6sLniJj0X(D+VXr)nzOkqImMπU"6sN-qLzh(Yh(sy:S?)]pU14HZc*Ob/U,,MA;*\:p_sN9uVvmXIvHShn+yA0I]2gπU"vjun6-TTDDxftH)?h)Hj^,sfW>IQjBvQDCeXhmTXaG#,ty+V>N2isew[W)\Vcg1πU"DKB_jeo:cR=$A=)4jd-B+4#)_JRjevOJkFNk8t)u8nC:^gEKZhc$PAc>w;P'7gpπU"r5gMlhyyz4=_82,G,hUmWT2$*H1YEXiu+w2WbT*>X[CqcK'aJGL4zo9(bzo#]lJπU"1\.f=ZBMZYb_mIamJsRfh=^)XE4^Ha_L:itE5AHS5YI0imKDp,5&.=Nd\+f/F3dπU"=P<kA_AcC8+YOMVlqEYOtfWd9^6g3MlJ9tXpw=6OKfkR9&XO,=z7Ccc<js'l#)+πU"q6JN3k]pxzU:xb:lEb:W.SpK<fTlPO3ce7KLWP3sigq.bb/:WLrtu(Bm:Zh7K3lπU"79WOHlp9OWQA.5bb:WeLru(NBKri41HTDS&r?HQqd3kfw_h(D%b6eTlPO3DULruπU"?(BmZbh7KLWP3sigq.bb/:WLrW_#M38k,4sZ?b(bEb:WLpru(BPK4i[\_0d3GiEπU"h.sL\mPWBKFi9E\1sY5MP3Esiq.5bb:WeLru(HBmZho7KLP&3CrrW_P'bY#sd3EπU"siq.5bb:WcX-Kl57(b>$2uaE6wWtlh+b#8eIr5UWP3sigq.bb/:WLrtu(Bm:Zh7πU"K6LP3CRtr?Li)i[TWP3sigq.bbn:WX'aK\c+,iEjyc7?Pv^3&rgo6K\LI/1qh2%πU"kqY1pRdDevvWW3w2QD5&vQaE'iy=0qXz:1ZhNRcP8]h#6_hzixxMI=[VtKKv.*BπU">X.ftZMS_u9LXQfq:er7gWCZ&r^hARGRdjCu;uk9bv<(n\qYh>M5h6j#WsH<sFeπU"Zd7jWN_3NZe?508+4s/F#:bE9<3TjjTnQGaA:*E=,f'D:7Bg>fg8dpr$;fX3qqnπU"IzWO$Kt_W6k/[/Z-?b%/uwR#7?G*LaidW$/3G<V)b7Uy$=yzGp$:0;EKa]+gg7wπU"&UDU5<uT$\/IYuO<VF1SmB1J*u$^ey[%U23oD0bMoL$1\zt)NxuVas+M&kO'-V7πU"WexSD9=&\#9gV*9xBpoN:p\i.z,/OE9bb<,&w?66kZ4DDq-M9Xf*oDGpU7mNQ%\πU";f#B+7/ZhuZ+4Icfe_eVPK3RkHp[=XZhNemD*kyeL^YYbnNR0hO4(h$/4c_F>H=πU"-&D-/c?Qv[,htyhObR]X>IGokq+^>wcDpH9RR3nS^u.R]ua$7-Rmb9ZfMPQlryAπU"TYsrS-Rm9_p&065)as;5k#t;67Y1*r6)1EG_xVZmhCj'WvKb.?Ln=g3Z9b+24ktπU"*HkjO>,A%EW'K2ji6w-Y8rER+=q&LUI9dZcXObS>ZCx74N,TG5WMzn66MN6tuE%πU"*u%im\',pJ:V_^xp;S8BxnOoD4*oCBz*hD9+RsA$oSO5]Zi^hc/b$Bqo4yOibfbπU"jB]fq_(NTBJQ4g%0]Wo$h+Q#J':bJ(hzDGnsf:a)l$sU3\gTk$1KG[:\=6af#pGπU"'jQT3.3ea4gV9F_=L:S#Qxn+,=\E*^t,&..Xn[t^(&qGMY(\s8CsMRT$E)=C<_?πU"e%Sf*ds-[\s3RhJRlf(f[,ORkF76,e]:UJoCM\-)D8Ec4%_XbhE7AQQok\&C\[KπU"dc=9rPLYajpL++=o,B[M>8o.\F*2qA'#1_6(KsJhq20K^>LGr[PbL7fK=h<9.JpπU"&3R(+k.?<wEi[KGSq:N\clf<TBw1I\GxZ20ke>kYMveM\_923DK>5$XoshLO/lUπU"=?eM>qgL[7+SP^DWv=wGh%LsE:FzW=U9Nt+>Xj<5e*4))b.M'P1EH0*?%l.W\R)πU"^daZVx?tmu9a\c#=Nt$<UxbsD()1V'QPD8alt.Fm>cWB^?l_IM7u:8Lbpq?vQYaπU"KjV6-A.0]n5<Q(u[Xwv=GB+ZqscNg_c.fiV6K\.cxpB5D0<E^-u]e(UH;YB'PHPπU"1c1=ePUHzu#]9LY]VbHqD6ZXfd^KkX70Q2b[39t3+K7aC7C=vfAqA%%[:P+PF[<πU"<M'i8YYCjqf;c\zGMZm%tG58bZ;Ru)dtEEIU62*HX&6VDFFv'Hd(KAZzs)p)X+:πU"3X=M'eqj,YH<'T[QX\2y\LDBF*Bh7E.q&Xa]FA5_$gh(0\m(%&Jk6QL[3ZvEYWQπU"Y-25S''S5)tJ2W*F-^6exLEw0gR/Fcj8KT*u/?nhx(%up()%9%%%#-%A6'$E?G.πU"lBr)%%%H0%%%-%%%%rf%siSt7go6y)<;xzp=MG6l6f,hQf6v*4$dAgAZQUuVfd+πU"[STDW]&<O-gFgVKX)[p1::>UZt,?JiK1Z'rF5iE3S#kqiT'>DBIW%/vW7-VC4%9πU"8yipeff#MM/SOW$+?A*TC..t5p5hZBblkipLm53f<nDZc/'mev<DnY=de^1&/x<πU";F;SCt:cfVr5<LlVjF=1h<jFm=c46Lk%87jc4v9BRPoPtrQCNJDMhhz9op9Xu[qπU"wTKtZG)\iwrG+[hBDXCJ6aUqW9j?P--_3T+PL_4^g7EDc(a3/iRpF?[BX-s1iU'πU"]'8At[#698PG)cT'(h4dO^7'S:r&,ZJJ39QcogStm;TnHjqCo+_<pI5t28z]loxπU"?_Gp[8N,Z/0huQRs$f]B5<3&;p$>7huMOSVZm?Y?xFFqUrP#Ib9TfmjPP%nJ_.AπU"G>3'g&&S,_27<*oGF,#DeL(OH&d.3oscc6(_Ju:j(G4%2_'U;/Qw:ga'M7eqKSiπU"Sto^mg0$jYRbIiImMn([.XzP5Lna4^Rlv5-\ntzD6CuMrcLne9.Uqb[I*v=%1ESπU"'x+2iMUgU3Q5p'd0[DUG$[^35eWN[6k$8P^cx^XiAnXj2B3kPBPY5v^>]OKp&]uπU"U.B^HU]S/&vU>J:Sbp.hbD3C?]6mwtPB&]p.865cH,fR9d2E]OnDhs-p'r[t*QAπU"8oT(;]Xv0B&PTBb3MIa*5gYHK?:n)GIt^W.Bd;0R(U(\;3H4]WH:jgUG-VjI0XrπU"w8bk;._tY7C]suT]c:eOq3rfoIxq2DqeT?MOO_>vS)]kU>2lj:/<Ta^RskNTYqwπU"Myy8iS0=:/%U9/jRG6?'dQ;z'Q''xxB*QP$%mY[[4_p</7$/430u(^_[#v#-MW?πU"ptVX7M-X5.dqQoKw<2Z'9lZdeaQOG;TeRKQD-G;R2eZ6E+<O6D;z-:/;<76S-YZπU":xJL//+'=)[X-X#=1c%sm1IKVS0)oH:;+ZL=[XWRUHE[8/6Zg.p8p58z1*m/WzTπU"=78v>g.6;yQLG+78('oCu#:y,tCGC/d';h0.1<)iuOzc&xB'wht(ySfz;lywG3;πU"TeK:Y\c?p27MM.M:0w[ReZ6MW?ptL.JUVs3/Au?.AC].jt5PZ=WWEX11wH3eA-_πU";af,E+8<L38]4$l.9q=DUcB1YEhv4fujv$*uZUAvrqF+$$S77tK7C,Pe$^gurYbπU"mprRH:7+#cstCKBHf1]FYC]rks]3?>k]GuDH_#jj;REtAp=OSB\ot>k\D6fKUs7πU"FbYm$(grbb.ARb.kGsthb(cg_iac\4m(jr0bd#p's*nm,n>QoS>:K^Yv#K^kxbnπU"+q:#.T5Nu>njcd+d9trGo$]Vd1;nXmhuWrv7E%3ssmTcr&a<LZdQh5U2tVAqku*πU"clw).&CG:8.iKmsv3FNHj4bu]chkZjmR*bDL_fnV(rV?WgmhXk0r(u't#D6Vl.xπU"?k4vACNFFlqqO[so9g]Fa9Bd#SBTHZjNkt;8BHHcPm$G-pp$(S1ws8TkNZEw%,uπU"p(%)9%%#%-%AH6bEIU&6Q^[(%%h%/%%.%%%%r%fsiU%SgfxN.%<>\jm5wmAIw<9πU"A_#TS6we+/zydzb05n2\1e=0c6tkj6?R3&p<?\mZPX7hkO(FKrbkvYhlhL_2hLhπU">NUjm=ra)HB<CyQJ=:B,7G=l'y#$1nm8=.>*ruf:RFs3\,Ht>3%M?4--r60k.*dπU"*6)hp>rrmOiE[U,$,?9wi)1g5iB1'8-A<X&s;fr$7/3DPT:OhNL,do:qGKB__X/πU"n-rf?M97wt2L98D(u7\yC\W?iL8S]F^UoUm:hgrPP>7;hH5N'Tt]V+rnnuAGQs2πU"4+:kevv5(qMr%[T^Db[29*\/\o]r9XrT7:djDPm.?;8Dz7,o/<2,g5(YcTMTOj<πU"\S?jXQ,bNS\<AuMYsG9>m*JpV1iewfQL?,E'dz+dy*]biMg+5W_g(G7hWQ#/:w/πU"vjD3U,3.O[JVQxfDRfgKG7XZ?r)avH7g&8_-HOD/>mj97NXCPYG+DUM]))_;pdwπU"xknf1-*/4ZA>jS<x5Vh;fM>#*I1)pxln1Xm+1G]s\a$U$f*F^J-(F$,\f+1/>?vπU"mOc/'A:d9aXn.f*k<t%T=mpiS<r]J9Ou]^[sZXcSHvjwaNL,ixUzI5I<a/^x5i[πU"yEEep^h''bAH4.t$.pExKgWm9uE7'A<>oKB&Aee7+auSVtS>h_>0ZMF;ARa]BGSπU"XSeGQ/4iruG;k_9_*L_]eOMB+C=zX-V1J9'PJ;^d09AFqEfkOpM]N,RI*?h5',+πU"<F;r?.ssEv=t3PT\uV.HMIFxVb*P>+AM&vI.*N\v<-RY:(j[ct(QCLw:kHiYJibπU"iI3'e$Sosvj2SR-I2$g<:a>d:SH-A:d)m8[5rU.[jUd;vq'&6Igc*.Zm&wkuT,nπU";b3\mUsD(wOS#>40ka6SnV%AK1$k#mZ38OvS:%Gvu/dVm\Taq45RS*Art?wZ?6kπU"_o:(?i;;gU0O#n>fhUI-3XiGqi9GB*aa0c3MqJb(ZGdl$uB<hLbbGa5H(f$H(]>πU"R8:djC:4Eavk8$uJVt/0x7&&3R2ywSvt3rct'ivCHUc2F]Ch.FGoa+m6Gb/QLP_πU".L*dvnJ2w$;Z<Xu$qXqD=NiOn9UiSpdKaA;UCY.0.?P0&-*:GYCbh3Kwg5wx<i/πU"X75H^VX1V$/SHo#H7dLQ#a66d+BAG*N8nA_\dHL(1k?eiKC[++m<u%p()9%%%%-πU"g%E*$sE>Rd%UD&%+%Y(%%%.%%%%rfs%iUSn7sh&w;,:;Up9L/I3x?$f_DCGs3eRπU"<Xcb%v-b2eV.k0Di.rKsLwltVElSRGT/mb4ZW<UBH^qP'0fo:Y%>DcI(n63i>y5πU"9&5XV\j9vEl=:$1)Rd8&C$Bp\YY&v0CfYMh6H(jaa[+LUZPFr[(FdaJ-DXY&:z8πU"Z6W9J;TlKnXR.RKfYi6#)1f$9F8Pf;p.5/E^q&Y#FK6*9\Xl<<7s]=V,+v^&]DOπU"w)k]:sA1=yFf2NPz9?:yWC44K:vFVh$.L3&Bmh0K\\3*;yZFcGRCkZ%9qNh?ChUπU":cKt)7p_,T6CL#YTQG2_=ql(\=F*9wVsDpEOL,;F:rNW$ZDv[3>.7$lQ4]36FrSπU"(ys6c:kpC)quYb/,L%'up(%)9%%#%-%U-6bE]E5T#_[(%%d%/%%.%%%%r%fsiV%πU"SgfxN.%<>\jm5wmAIw<9A_PTn6w\-UzyCysUW]1\1e=0c2tkj6?R3&s<i>b6(8LπU"Xg&.CKWbkv_hlhL_qh,_>]brt0YC&$3S4zea5Y](.$0H&N(BUIt<0S['ZwD[;jLπU"6j'*v1,PK1A.+VM/kd*d*6)hp>rrmOiE[U,$,?9wi)1g5iB1'8-A<s&3Z#JBY*,πU"c<;/9l83ynJ/KF8)Bl>UN(uE<mZYMKu7/-X(u7\yC\W?iL8S]F^UoUm:hgrPP>7πU";hH5N'Tt]V+rn.vAWQs&4+:kevjk(qL#2;.AcaU29*b/Po]u9BqV:JNjDPm.?;3πU"nxK4J;TA6aF+9NSxXOj<\S?jUQzbNN&&wu2YsG_Lc2zf9=YRvS#tY5e,Pz1\w/AπU"LAxV^NoHVXj;U3)\WOs9qCdC26&:&VJVQxfBRfgKG7XZEKHBL6XAOYm)i$4T0RGπU"/89M^:?K(4=9A.RmZJSxNGI_+SR4X?]0q90NWho/p8\['7+&PxGI+1I(+afv#mlπU"W6$*F^J-(F$,\f+1/>?vdOcE'A:d:a=n.flb<tvTOmp_f5K#7/aMkl?hi>DfcwqπU"MBobSFM%Nbcb=q)kN(r#z5De7su8:4#m?;wA'J_y8FMI8MkO%#?U\ClP+\t)<3YπU"Ep2E;uHj/>L,)AR4s+-A2/$mZf'_wu,)52>HG-3Kt9c3+4[xX-V1J9'PR;^d09AπU"FVEfkzdvAz-RI*?h4],+<F;r?.sq?tBO$oHJYK3ohU_3c?Zkw<Oc\cwhbz7VcRKπU"#54o9k8mCzJ?D7T4WWC_,xx?Dw;j#N_c&(<PI\$k1r+H1;J^kE^V9&Z6GDiEXwiπU"9$wMZj%Sl+8o+boWCC4zA-M[]T]ypY?c;uMYZ$2A[^)e/6WZ\hZKv.MS,(i5Y94πU"WDt.A<-p$w6>9,4hDfWP>'#Y%,>MP8GzDec6cOn[tj/gQ9-7a\DHtxgY$RY^)W+πU"aSVrbMhphb$]BB7cDBKaDu(wB^-S2D]a<kglFnT0wp+*;3^b2ND=nC4lp,.AH>eπU"nR&A[pDjWJU[PgIVbEZ?k]peza*0gyI6Ti;dRWvEf7=Cixq\Wi7d7XRfk__:Z?dπU"s/:[FUl_k7%:[S.&.DBQB6\30K=k%Q7q$;nG=t\lJskM;,E]_2zs[=#k_L.Db[8πU".sXMs:cIw+%up()%9%%%#-%'+]$EZp&L%M&7%%S(%%%.%%%%rf%siVS[nsh&\avπU"t;IU9Tnk(;N1%FK#+I.f.H_/*JA[Q)U[b2#?&WM\-lW)Nh,dzEbabR44FlfgFHRπU"^r_-$O&r#o6DK)^$u&uT4o.)K,ZlZ\7qL&dWGX3.Xd9Za?'9b++E0,:N1>y(vAFπU".kqZk96[:VJTX#(\Go_k*HIY<G0D7-j(DhUG>L/m3JJ2H9&S)+#q-OI)Lz+:m=yπU"pgvud3XTip>I1&JYOb%%,5<SOXQYpbf33Q6Y5%C3%mI>#jGIP[ba[lA5Bg'_dRnπU"c4bY)A+P-XA1$u(t]R2F6++uO?Tvi/Vg+XL&hix_Wck-VN\*L\e?ShZ,n(fUi#%πU"so$oIJ,D;JsNo[B^w5?ckcr_&4Fc:GBMD&wk7O-L*wcZ0DM,lf(u%p()9%%%%-pπU"%^6bdE<V%*(_(%+%f/%%%.%%%%rfs%iWSgRfx.%<T=Tk(5L[&Hw<ew&qpjl;ab9πU"f[E)9.>ERi+nYoU7OVM)-&JnOIszDrsBgrYxd?*YCQtYlhLbB5fhB$J,fLR,d3RπU"((:E4sGHP%;<-1eDVFHBLRpr1Ox+a]TnhVu:8']:/S#C<fDgYK^q5R)fa*,7*/6πU"H,qf364on-&e&g0s3pV9/E5o#bM5elTNZ15=%wNzf&,B2gpj2H_PHZ.P:,ppYeoπU".tEvUgz\p_fMcIeE-E6R&TnpD;UM.HZ4ZD]&+j9S%D*_NjFYJd0ee#>hOp<4ZpjπU"B,LBWr/;tSW*4%[G,s#ThSrZcxiqPl/Mvksb)5A;hVAyUyvG')>P8?X<*%uQx.-πU"peiOa[lRq[&S-7L3Fl>bPqjD&%E[qO?pq6?mTub#Kf##a:3W'b'>ZwIZGk&*3#GπU"6q<An07a3?jhV)8aaBA$-mRMsD-%eGPqi>zo1+?#pYkl:JQ-h'ai[c%#jQE+zfMπEND SUBπSUB V2πU"gPIj[pb34m#$SE0rIic%f#ja>u>L8Z+^X#>;J&[Z9IaT=:Izi+U<t[2?$3ox^FhπU"yT>MM/D3.\C4PHBF[DuOGNY3%r%QPg^^qakgKpqlK\-L<)PGnK9&g*0X_Y33o?SπU"[Ie^#Q%ndME6fb8^xY=WG_g7jj/cY=gPgc-PGYTM-p>+?LoYIfdZu)Wf(G9nP_'πU"b:Ru$q-d)tf+noEcOZL\*Ug#V1P$fq_V:e,cV.\['&tJNUlG=hbX]Y_:\KVBhrXπU"\R$ufjbSP6c_x?<bt41(]zpu6(s?hwj;i\e&#vWK&f8HM6aG6DaCr8tSt0p<taqπU"D+,)a6UAZZHB[/f4aSdD#'TkW2Kg]jJTdfqo'&Ig&[*Zme&wuTb,ng*e#Iv3A&yπU"<bP^+Gm(Pfh%b3dBWR]IV.-dPZ%h>5e\5,pTajq4RSn*atiuwZ6kB_o(?Ki;gU*πU"09n>CfhI-W3XBqkU9B,:aac35MGa(5ZAr:uL]p7]mCnWY$el$>;k:diY.]YFW_MπU"Hi:HCpu2f8=RzeoguW)eognFCX2d_f&9m>9FOC3X',11Gi$K<<'(FN4y2TMZnajπU"+2H]oH8>;KXZ&4dNW-'hPVXfQ387O;7]>eh6QB\7W?d5iq&e/<BElFi\Rn/j6Z)πU"-,GLCKjx6XJba*fYl\QykbqU5->Bl4W\SL[)n&=b&N(up%()9%%%%-%<p+$E]8mπU"jp%N&%%'Q(%%%.%%%%rfsi%WSnsah&wJ+s;U9MLUSN'1FK##+.6.2H/*JBAM)56πU"=#]ZD)x#(g$0Nhn<z9>*aR$4rF<h2i$kjMc2%4&\uX#J/o\pc]u#k&rO;&_dj]pπU"L$/Xm;cW;0T)\UHjo3*vECfY]62H8G&Zj<JaZ9cWRnWD-TUfq[);(q?<GGF7-AtπU"cUpjjs3R,J%:9&x;7=);H.g9:S$o*js_\Xh&:Drx?Lhu\eBA&G%[EdS&J)%8,SzπU"qDI>no;YOAYC\k\UngIWt[B+tQLFJ[UmvN;%EAP-XnGo_e6*5$X[DSiQ_R-LkFkπU"hUNUL)SSB_gm>d#\p;JR]gFWFdELf1Ptsmff^po5R'W3XJn93L2dYk3$z<u90boπU"S^<s2O9S+4U8T?scv)g,;hup%()9%%%%-%>f6bEY)Tf.&_(%%'d/%%%.%%%%rfsπU"i%XSgfjx.%T,=Tk5\L[&wK<ewq#pjla,2<fER)Y.EHRi+Y=oU7VNM)-J%nOIzuDπU"rsg.rYx?p*YCt3YlhbMB5fBq$J,\pR,dR_((:TJsGH%3;,-e_D^FBfL2p1>Ox+]πU"TTvhuk:8':R7S#6\f<q7DEKXQ+EmRYM.UW(TuE+,Btt)ZC%p^V3t=/$+-IRdhmrπU"z^4215%lwnD&L,&Af=[#7'Z_NM=NEUU)lSPeoR#/&U'c)vhr,RIoBo+9UeM-&wEπU"KjT)UK>bq6I/)[]xP/RY*8.[tZA-7mM08hbgf0G%,8Sj4QQ\7^^?_wk?B.uqV63πU"/etcdhbP^jG(zWqjkDe[nK_]p#j6D9sG.d2yAxGNmn\tQc[JVr/ayU81>(PCO^SπU"y'#)C5qt9H^_$D-b1EE?Y9'rmV'Z&;JE8hX/9t2+__Y5-H[nYb]rO%ie?Iu&l+;πU"I#6T.-.#Z]'5,\/e];s>,aM9LRbS;U8,2k$cJT9hjETuXA#&.R'OyLb(SaQSbmxπU"2HurWBQTT7(O?_RSEq(TP1%M:D$6P.n/rBsSoYr/vwq<s4H4p74Y7*9r8b2F\3NπU"o?GcN]Cj5EccCmfgL'r;ku1O%-pYL?L.#hLI0N3d&my-O$4kKSk'#?)UCpP*+p)πU"<r3Ex2hEuHjU+L\iB/,l(J>VT<NHAeBEM#r>qMEC-F3t9c;3^[x=XV1H+9PR;]RπU"S/2\5^0r0NM]z_)a'\Lqkh]p(=7;n6<\Vom(t5dbc,t#qBWD7]b8=h?+,c,LN\kπU"iV3RpX1QafE79trZg^:J1kv:OkDR.1mMj#$fcG_]:k-%mp;&1]?J'v5\GVg]*<3πU"OOEut9DL2OE6^Qwf3SaWV;Mz&Y\RH^NR\q_$xUMZ$t&A^)eZ/Ww\shKv._M,(i_πU"=5^Wpr.A<f-$w6u>,ph#DcM>B'Y%JM>P8G2zec6Scn[tDjgQ9a-5YDp8xgZo$QRπU",/Wa)V:rMhp<h$]B]BcDB7KDu(-w^%SM2]a&SklpnHTw0+g*3VbORD=nACl4,(.πU"HBe\.%A[5pTWJ&UPgI<VEZ?-kpez6a0gyUI*l;[dVvE\f=CjhB\WiB'7XR<f__PπU"ZZdqeI>Fg[pKr*'_XN*M3O0FisYWi2+>*mU<dK[6(dD;]cB,zR:^[&_VX>Aj:DLπU"mUms]Gqs^sar%#up(%)9%%#%-%#b,$Er(^s]N[&%%S%(%%.%%%%r%fsiX%Snsh*πU"&aftB;e5T<H_iDjK=s>Ryg=GT\eTd(E4FuRHC0C/rP:pbE0gx66LyeOOJRlr<5/πU"lNFJ>b;)fnzDz8rVQMh]x=,x'gl&O;&B_jUuDbE6$=)V2#'-#2p_Y3(_DTR9$&1πU"OT]VnG:?pf/rYsgAp?fgEw2fJJ7i405tV3(q^qC=$af0m3J22(1S)I+#mRHI)z+πU"e:C&pquwN8Zff(>5I1JY%Oa%,45^OXEQYbfu336]D5-1%amSvwKGI[8dmk3Z>k4πU"2tXFb-i.2Qz9;S'*BnwY<e?5E+Omrz3tcZ^V2-7xW.V5C]kW-V\*2L\?KkhZn(RπU"fU<%sI^fnpoubo>kw=cuCvZ]Skc_&u4F:GO?M&w^kw4,p$wZ0jDMlf%(up(%)9%πU"%#%-%s-6bE:JKOP_[(%%d%/%%.%%%%r%fsiY%SgfxN.%(>BTk5MR[&wV&Pujl0>πU"ia4I]-SO,uOS#h-ow=]f#h&Q^.fsRgw.k>.X6iDbyvobw54WkhR>7HR^AAV>E5tπU"&:b$P2z1jyaIHo1fD0wgdVIH3[F9<i/.;6$lcVCfd<P';u^qmkYQBP]A>k5Sr7TπU"_D.5VZDji/:x)X/6EjY$?X(2;,&Z3^#B>C.5&oP198u7'nYsogK_rQ&95kiS\R]πU"Iupt6SKMhGpNulLE97Es5SWW>O;I4QZC.IoljD]^R,9SY%D_NdjFJd30e#6GhO<πU"4cZpB,YL:r/3;tW*'4vG,Os#6fQu>NGhu:*cFxrC'P-]+T]Ayy#NG'>][8?<*r%πU"ux.3WoiOta[Rq5S&-7$L3p>LbPjDZ&%[qCO?q6??mv^W#K#:Ya:G'e$'ZwfIZk&πU"()3G61q<n0p7a?dJhV8a.aD_-LmRsD2-%GHkqizof1+VpoYk:JPQ-'aki[s#XjQπU")zCfMLIGj[B3-Tm$SUE0Ii<cs#jta>>lc8Z^XI$>J*9[:IaA*#IzBi?<tr[2$3BπU"oxFhjyTMMT/D.\kCpHBN0[uOgGN1%9rkPCL3^akG=LqluK<Lvd)PnLC9&*0kX_3πU"33oGWI*e^Q%LndE62fb^xTY=G_)=8j[bcYgPogdPGRYTWoq>+Lo9YMdRYu)f(3GπU"A]_u'bFHoWX&<[c*JR>rqMqa\g->_DZj/SZg'(0GgMZMY2de,s9]8V6u\Otj(ibπU"3>GF[q5n0#Mv:nxChu3vB$<(]nzp6(Qs?wj5;iP&X#vK&rf8M6saq9a/CrtSBt0πU"<tQaq+,p)aUAnZ:B[^/faS'.D'TLkWKge]jT8;cq'&6Ig[*.Zm&whuj<n4o*#I)πU"vIuyGv$D4-j5ySnV%AO6T8#mu38O(n:%WFsQ#4bL0HgEX,.0Guowv<X,^Fd:+/hπU"RdU2>N/aWQW4n5C8Abj2P2f5HGTNbukCJJ;$dlPuB<hLbbba5HRo$HR]qRN98jAπU"94EjvkYllawBTMNPzOTeU64lRfbg*apPF9((a0AOhaCX#*=?gjWsT^S+hw^Cw/vπU"L;bY3;:mfL:KYr7f<HM'766Wz;15)BEKKJK+BXWHU)bJ3aYOZj<(OS_ie]W?%#cπU"\HI;.5lRta[vBG'LHB/O$V]*zLjU2Hlr8^C?.'#>dl.DbN(%up()%9%%%R-%L,KπU"$EDK'u\N&7%%S(%%%.%%%%rf%siYS[nsh&\aft;de5TH+YZdq8Wn:ypgqj?,P/PπU"f0Cgok:a=bkcP'RbV=TwJDvz'x.i4E3>jRG\Hh6r9J.[&<NDm\w*Xnu4Nw,d)trπU"RSOdjUpL.s:$)EvT#CJ)R*YmY&v;CfYM62H(#cWjQJaZ9c:Tk_hD0VVo[)7>u\<πU"PGD1-dlDhI^GL[m(3J*j)yT)+%.TfM6Q_+NXCPp52wDL$-QX1+E1JYy%a%,5_dOπU"XQJYbfyZ76[I7v2OmVErklUngI_>[BK^2FBng3K:*R+QT-gbk,B]q(PR2HB+[utπU"H/tZo^V22]xW._kCek-PV\*LDR?Fh<_n(fQ)9%s6_oIJ3,;JsbNSbCZvZ]kjc_&πU"43]/64&jPyH<MVrB=YiT4>jGo&%up()%9%%%m-%&69bEiy6rl$(7%%f/%%%.%%%πU"%rf%siZS[gfx.M%*>r.k9M3s7xZAPyPfit,T2Aqzd.;qGaK>8OUWrZt?[XFXB%-πU"r9\,8*7BX&^\yyN;hVE^Y67lls>G>bRqt0C3&2vjYhh[aD38&F8(3^b\U]p/bS[πU"Aw6D[;Lr6j'vG1rPgF1HL&4q7Ea[X)di.QY.*)W(adT-<on(-ecg8B3p;-7fEeQπU"0uG]D5z#'egcGPrPdgHK]S<]7b(_zWP=EinU?SP,Uo#/r%icqn0r,v*9E4+.9)-πU"%pX>^Gef2b4q)o9/7?[hPj/Q*8pZ[DI--7M0l8h_f+pG,H^STQQA\7^?ja5giX<πU"xZiF0TwnWCB:A(h6;E.xvl_D2l^]_8cl+YiwPI)R9On;Qv<X0/_#i]\B:pp)=O.πU";q[kW0#6l?6\pfA0lB>m1/J2r8AQsh<P?3;)_$iU*.HSmIm7<u$?wsk&KiGEUZaπU"?HXv[&Wu;(SZR?AXR%#*l(3K/XP,Y,3<>0D'+WRla<kYp_gGah]VAgfPy',3<nsπU"?^HxkU$KhP3e,PTPe,Cq2_-=C#k<Yq^ldS1tT3wb4tvR\My[Kac]JT^ViAkWeX*πU"52*,J]^cYX3.pwDo&^t48*%Gs75+_SJqibbSf\Va)+d+%I4zKmsmkD#9^VkFR3JπU"a;Nu:2'VPN'k8be8fXRQqTTYb%0g6;/:^/z^9RgqFMr_m8Ro%NMnDi>v53\#lM'πU"8)Q-<jMYi^OQ^&rI]w8XDB[x#&5_3Q]+Zc8+?gTKlelEqbCfW.uHMwqWky##1zxπU"FzBX=zbBncU/W&.3yLb\yfAJD=lW'xMt>NZ55LBnxZCek>(07K8y$[Ql4oo'Y>^πU"-p,\70vZT2tw:%0-b4fO2KeciBE&7^w;AB\xC9NHr^l(daTdDmF%+nU3>ebuo(NπU"d29OFxiD#>3aggLfG-^RmhLGNxLfHBt.+]G0jqF*.2s[oqm7TV=\3vhY2t(mmAHπU"4dv$jPj]iJY7u2J&I4aIheoBre[H9hDiTCl?>B=58[au1xUm>.[KLJJq>(5E4sbπU"_G7pA9d%s']Y5<VAUQV+.6G8\j0P_8^,yg8^jsIbVU6tX;X17i3iWnPUiWptJg>πU";VCI*0.?#,E5*:7U?^1Dru:Po/;f4HqJYeHF_gjQ8dU8^qxQ.=#eW'ZO#G;NnKsπU"hgu]hrV#;>8?H#;[m8&%up()%9%%%#-%t-0$Eyh%9YO&7%%S(%%%.%%%%rf%siZπU"S[nsh&\aft;de5TH,_iDK<=s>y#gGV-4]IEJ^m(-MbW#RVZaCSaZV&INHh-O_joπU"m/$W)hfKZlWTsiO4LN;9)LFln42c6:8zuJzZ*zeH6[b)s,iI:fFg+Tfk<aOGROHπU"BZEjsbgC0GCL-U+^5'c1s5k6*I$-9=\C.?ug'>8E,zaH87kIHJ66<-hAe=FP<:UπU"$E^Y;:Pti#N6gN9,XumovTFCgC\7/49&7i^Y1W/1Ht$'=T2/h<R:haEc8.X.2?/πU"a6(]<$=gxRm_&5+(DO*1F%;,+OFU$=T,%oUxdgM_GHq'Hh8qQ%>B^LZfZq%/.HkπU"nY5q$:=5E):gnHJ6;a83bSvd*^)AN]^qv^rNq=B),F+n:ys6c<ep39qfg,D6t%%πU"up(%)9%%#%-%EG*$EmW\zKl#+%%%%4%%/%%%%r%fsij%qSugOq6%N8;8PBHx5$nπU"kL*ll(^#W\O_>5SO5;kg.Iprs-d>F.&sJ5RFKB_\79+g[[keIDSsnFk1)%RPDiXπU".<(7bWYn\ndO5QsVxks?CGrsR.SU+N)D4w4DB0Gepw7O:&:QWpllG?/AxR7:XJuπU"huW$ulv7hl$7F$bF\dm2ZJh%/WF3R:kL6H:\PU#uSRR),z\Vluh'G'?_OYu%xpUπU"$h=q#I^Y=.3Zs4;L.bh,$O/2e/auS?S?*nWOeS]&5>VA>Yn82Wle90);/,h0EM9πU"VK7ZhAwUN6rVUD2MwuPT8NCNX0N7YCm9pGLX$?-MhD];?Cm$8VluR12*MCsxJ7qπU"_Rp#wrNw(>LiQEk;p:v[XDwkvS6A)CbU;F\6-w6[2;F)*J$V]>RJ*?8=B#Tj>Z=πU"wY[x+-_[_-1$Uq/oq?&9r'9)Ja)&MVxnM/0X=m.=Bp,uCa(HMEuW/_RipK=wM=NπU"kHi0BLq^P)H4A:$irg-gZG-9$/Q*SDQF=MRbhp('Az=zmV0SH<*nEcm(+5HfO.cπU"Qq1Taw:7URSeptk+hStwN)0Jyk+nK3,/kMT's<Mx3enTJ0Q5GRY:#dK<6Wp5eJ:πU"-oGjmf%B$_a^;%)f9RR;n+)/<[(S=N*TBp3v,-.yv+SFZ]kh\zACqphD9\69RBSπU"r)8A-d9.q^%Ud$(DEidfKPio)6wOiG*$<c7$RmLkZ%tp4]H>GHsyGV0]A37r7YUπU"?j$sgn]=<2AkSe8r_\IHt]jfoDZO.jc4V^CK)*35J(mkJ&p1RA:%=tK6b0Hj-W,πU"ZuV<VHT&%*kxZjV--,aL&rafNg*36=%,H'V<+]on/72A#jcJKT_o_Z$uKPR7:ekπU"\U^$D5Y$6,tRG8>dpoy?XA5bBw-((\kKn:K'K:rvrOgPD2es#l5IJna46RZ?MkYπU"[E4dbC^PcdNYFuhpPMuMMNNI*'Puquu//O[<.&5pto\8QKM?PDqCw(*S.RjsqKsπU"pknWaoLDob^_>4do7kV0E*OUp*>XeeTX7I*+(sH&>,$f64bIy,'/95K]-]fx0a[πU"7/0-/7?&>:?9#2[Rn:Up>.XjJUYM%p7-jjLGlJ9oTu'10-8V)kiGf-o^_*n7zC=πU"r\&o*lGZt/4&0gJZ8O9APOhDIgzHBDy_z'WMK;SI;L3(6.Dyx/%:(z\HxyR>xCoπU"'*;S;LmA3Nb#upByiDpy5B2ylx*c?;5FK-]pW(0c;8vm(jjg=*c&di^d7435'5KπU"sad/l7-snX.)TL<.LM3b19sZ;kZZ]PSyJ-rf0JtCwt&tZB2FuqXkA=Llf]6nSK4πU"r_y*utzX>xVk'h]<Wd#QIXXFbXrh5tu7u3Qqc+3tBcPs#.3G^mb/oy+O^LkkphCπU"r0fbf0HdUtLO=mVlEOxxR4Fx0Vm<s<o%XxhFti75sghN_xx;R;cH.'tLB74UnfhπU"mIFu2%KvA3x*q4RDlefS>/[D9<RstmVF)8rwjmUM]F*:k2/SYo3BxYhj>)*X?l=πU"68^FejQ/M#zW_,tJY^6A=*xP;VGQ[(En)QJGOcwfG(^Mb#i0i6igg89;1?XFPa6πU"P0BQANCsNoSciB)8w5LgUHOSYtH=FgC:5,xhwd4nvRU2*_wd[nbovOBcnS]RD,;πU"LQCa-K1VUV87TRLr'M3pZhga>ZadQ<AKjc=R#1nS2JE=(d3C0iMZM9Kg,2Qj2lZπU"J[nUFUED==^2(5\XX85vch%iC:q(f3sHZ_<+dj(^C]>(E)2ZA[d0(FvaHWar+;dπU"k8C#>Oo(giFWifQmbxxP77lX'?KLLn2xLLPbLbU+rJVb8HQC6>9JNnA]Zt7KEbuπU"uUNMs'*mGYsoaV,G4rRi/kgUmBUf%I5pi*rji\aStK/$u#:X-CKk,2TEtcol.74πU"r\7<q[XTJ6Ds]Iud)[b6Y#mnSU-Kg<h\l5jbR/D-3uRU279&BiM3_'#acg7($=kπU"n'K,15$ueWXlo6=bvDnoh$4y#]]pMH^yVRM4jP#&U\>7#24$E/bslaBB/IxJ-q4πU"ybO]i)F;i0j)cqDy.CU-BX\FGwdeIfYuu^6ANI$6$-GuS8,%mryTJ[Pk,+=0l[VπU"bbQ,;h2e0]\zkU<c*#v;44.Q'CfCO^7AZv[z0KC7mi5$f6FRS+8TegToHLl_mmmπU"hDFl_kTRXeJo\rSfWtJ4I'x4up%()9%%%%-%?s7aE0FZ1m&&5%%'AK%%%/%%%%wπU"jfi%rjSVRxy&)).B#\MaNnyor'pMS#zCaCX3mYLw;vKqJa%=Fo&Qnu]VFr<Zy9>πU":1XL1%e(=vrmv8g#+UA)Gy.Dq8y]]1uIawn]x+d'OIMy$q?DswufqL^d,M\o:g8πU"p_QHk[n5mW-&Ww\9i'GPRB7M2;^0RSiR%YgT$i*c#jHnRD0T*lC5rjN+m'Z%xh/πU"q;esi?6v0c5moa#o[0:+aUo4O#^&?UYj91=0,B)-Ocf[^3?6E8]tk1cowoLs=dYπU"Yuou_[B[bq^)_okoW'*(\-n+GWaDG3LqpfhH5JwcSPj'aJI1W*0?jm4]DkNTVe&πU"+^s?lX+\fvKJLpBJ,hq0>wVC%M,J<,>+\lT*FmchR$rcdJ$s(KJl$uo_X<iW.YWπU"rujeFGFeBN^<JTxjgo]8ZBWj]W6Z8^:dkvbpR=M;F/42Z#4w)P#cE5Bc0x]4o>bπU"x96Lq25ihzwki:;s>U\f$#L:=OmJvsz,[Unikue_[mZfN>G,ItVQ(y]<vHusm.WπU"9hS>_Sd%mq<<F68yuq%[Jx+$/$l0P)wcP#hp)8V\:)PH_?r:S^P3592'O4L*[R'πU"e.G.X4?^<3v=J+#pUyZX3mZ+q1mgci=&t:R7//K9P7Jh+Z(Bcgh0$IBF;it*mo)πU"2cmi++8n$2bSHe9IZDLRg\UCi>1vC?-s]V-miIs&xuv.9.q9LMvdn1$4$.Q;ZCPπU"aEl>t'O9Ugem+^RZCYY9,SxdIGHMw8oZvwSAi;t#CIm)sFT5WI'EImU5eG>1>OgπU"S*(GW%.]+friJI]^;fW0z=.'nK/AA7ktY7C'0bQ%2dY,IHvYRBZj'lVF.J)cGKjπU"NP]GVI\huhV>7:Ft$jmeL_gJK0NLR*jG1*aSIdj(7\4f$sAA^Nn%dFI-xPv%0D>πU"^&6.oh'[bI>3a3+f5>[baU8wCrGn_T=Zxt_/%YbQ%HNL+Fd7ztm:7T-wCY#,Gl<πU"QrWYy'm/A9I&0:j);1pi*uE^e)hC#UZezYC$971^UZkYe=470kq9yJ[iU/+JgJBπU"'+gG->zdCzA1;OpeiRYvRTIRES]mc5#09)sE6&sUaxhjL[n]b44bqCm8mmHCkYfπU"7Vm-RZ9SC[H+V8tMV_2Op]jO'Tx\S>>vev<niQ\5O\&SkWhm9k5-1fx\VJ:9js2πU"C3/QmO,(]&W-nJ/#bYp6WBp0#3'IqGdZ&A=f'c-qAu:(CGW-%)No$IJ,#/L/EcYπU".>;O=H+^VelT'%$\$>Rvqeia<*Bn7nkVDmUXN<YetnCsQf?XY6NKiQKrbntDY:wπU"J2If-nB.>?A==*W$xM%W<r&=g)P5PH_saVt9jGu0>Nf[=udB[,Iq?o#Ti8p\bjeπU"K1%$6^h*fu8NxO*'\5rhlK-,\oN?n3.U-4RIot0n^UY,$/(%H_$rdrwr2R\YJ]?πU"(1cg#MMq5^QjbZ\\,$\.fqiYsa-eV0Q:G$>2GSmBxKUUl5gds3hf6aSK7WB:NABπU"^n5VcMBCB\z]E,/-iDT]-<prI\iq8p/wM6;1&;J0'Vj'^;w.0+w.4t3l[OKh2[WπU"g#UK;HJ4WEM/l5.#^9G1P>3KJ]aQgVoCSUA)06uiW,)K3l^]SxglZ<oeH4j-o/$πU"C(;t*uE]e-s.FZWEwF/IYUx4;D$dXQ/uQ4*JW$IXO/I%Y_xv6G]V1sBg-+/[&frπU"bZ:#SM%/M2dugv5$3fn,3'OVDXhCr#X1x;4JHkS^h5KgKQGT]8F$+NI=:KCk2AQπU"y1nF(&2_v3Q>phP]arh&uuZsF<^q>Q>:kC07jUu;Lqm*SSoVZ5vq0+Nulnpur.;πU";-8.1wfuh'/v^/;P]$F5XZHT,_m&lW,TetabEX0r+X<+HR\5FKuqGbmA96Q(GQVπU"',JowU21r_5S)yXQ0i(6M'm-LBobx+bf$>:D%#g+z5<\XFe&aF]kdmh[Rko[CR/πU"LG%)qC:okvRHtt37DLhp'rhGcI&.N(&yCV88TVKu?$yn/H/%([t6+$JwT][DIDgπU"lG,d).zQMYk4lY%8cbPoMA*o1KAeZ6C_wy,(pZ17g/3K?k$)D&UosE8q2<-\%]nπU";1Mf6&;V&UDoP%a]c6URg])tb97GR.Fcer7xI/-B9'sS2;RDp'gySaGTl&ugL>RπU"H0kG+pi%k40wseSO#>IURT^wIGweXaPk1p2wt]jW?U+GdB'8$Jae&y8+.Cn\v0PπU"U&YvHbVeub)Vl6HM4tSO4[vB-p3,?+]+a]5_*r^3F5j7IZ(*(Ncndwx,o09;X>iπU">[^Xwr<CV%Z_(SadO*C2dx-)d\Qua/^..G6:U-u$Req839kH2+XtOJn:+5)Ht$7πU"+I^=]<fe]Iq+ND.JfArW/paZATn3XYPtqqw-?117-#\85Y3/5mXJ^Av*^U:fD9'πU"-QI5J+F/Zkdu)h%E#FJ6k+'xUP2)6%zp(neCZ%7pkLNht4X7#T&3t]A>eqm#s7[πU"3XcH\Er1J7L.GS*(>^nBe;70bKNm$3YBvaYvv3:#MXw-2%<w:sgRW[)RDQg7B#XπU"%_6+o5W<>4kP)),*L[#'D93gNXVmPdtn78P*Q;#NRH&$>Q:AKJ#,_G0)?F&[?P<πU"mWTdF-Ih*$l*\m29rk#QI)ABC==qNK8fb/n$xp\80]8irG-eNA_h'9LYq/X6iWyπU"C*&lRH$*=\GQ8b\0N\+N5&Cu6$SC3'=$8g]epTd\%1?omM?:(yk)B_oOP\p;CqHπU"l<=4l-R4gVe]S[jZbf%uWWXHhq<N&eld#NYaFtHOCO0QRd68w)$Ma'g.*:;\mmNπU"T*p,<I?*PT2v=P+EjE6+tY'x'151hVsWgLDBL:[jSE)k_[uz*16^5hCoZbVdx4JπU"_Fqm8%abB?>[[#3Y0MFTF#A^py1T=sX#r<G'3sZPMoHK<O-xj)2&E(S]0aMrVupπU"e;LMrFVHg[LY9BuP'#I)ZJ13f/-'r<HIJHWSlr#D=36T_t%L%i\soh]n)tWkz.#πU"h;$6POVhNt2X/^(\8xq\#6KJI8rJtV?.kKneJT2R1_NL):P2N<(?HYHA>k9?ewbπU"Z&F2pGL/WZc/=pL/qJdrXkYd<l2n.D$RFSR1BXd#ptBM9Yr*,UukRZd7*>Bag?%πU"fSCo]nuNm2$ekrJcA6:dNM.lN?_.QQ0pegG6B8)9\aNU]?w$H]/^B#-msL:+xBWπU"NpD_4R%ukI(IP+WA669HbYo&B8-[1/*>nfa/P*'cfA+z540cmTBT<^6u6cMZ$-2πU"dDGEQwO-?#A&v^N*3a\$KOSLvDXAFmL^3'Ao6?eFOw%fkQG0^3t7pPRJw_l*LujπU"FPLR&npPmTgZnY):xD<J/,>Quhm#RA/4nropCI=3S^pCq4Tx'7BuwPA\K[3ggTDπU"m2<.cE#6+<2);88WEtCB#[YVfGA0csVg%Cfag5-H3N&W;47kgVWDO5OogtWF:G#πU"85ieGh?e:rczBgaNk-;DspF)415=R%o>p(T\j\/eEWRbhKm6Mdl89PaF;*FNLsqπU"WB,hR$Alb_986XUD,lE&Knb.0]^*;uIg:(QJeAiyjhzoCZ/VkKnMGa$fRVv<rLhπU"aT$nt$gxF._oG-:&XOEFi,A4QR;.^s3HEReg.yt+SCL=n#cUADb/ZCw[.V3O0E6πU";]WNi\ywnp.0.whUzpg*qB^A?/pvtA29;Z4)SdGI^p53OP3fDr<O:G<qLrJKTqLπU"^xc7?>$9RA2c=4r):,0P%*(:CP=K^6yJ79gQg+]^g\phHO(s1NX[Y]QhCId7052πU"HEuo6:,4jV<c4rV2Qn_/(wm2bRB5?FMe*,uHW::lBux2-omI2]+40o)W/&w]Yd6πU"c09OYenQ*i==cwA3r0'P*R[CS0J>,]5b7M+2gcmoaBP_jdkeF#I8)aZq.(5ER:#πU"PY9JHQ#l^k8$/,F,L8O3\_R*;S[OuMJUi+khl7Dx9Cop0^35_Mq;ddFva7IE3,\πU"*.a__I3TC+N+:m2%7nV1,6I=vPP%:ccM>M4UD[1*JM9[/N,ai#lZgw02;y.x?f?πU"BX7MQSK->/=*QKQEfa*LU,giYD#K&N9qERMnRH7.fe(<yvao3lRlo%v&kGRcc'LπU"u>P9Uuah/[0NP^hNQULgEdppRwPcdeb$u%_jqb4\,US+,=0W#%<G6\32RSnn,0VπU"E3m(%c_GxB^B$ul)_pfW_f=ar1*AU?$T0,NE3f?4u#[WPT'\^j)RS1JcYv+9$8VπU"m4*YSAllNCbPzW94MI8>6nUJH3%jJ6pzyBMPY5I((PE$RJJUW'YW2jv1gt^h8E1πU"^aQl$R%B<VB%#)JK4D2b'nEDQg?o?Mpzv]8E$gN9W*$o%_i6hx\pvHtEGY,rkRSπU"4a'Ca5eTvy1#Of2PHGvb.(nO4&>8Mf=vR^5XvmbHd7I1(lA+jIyVSewdkQSc3UFπU"2nMK*L_K:Spd$H.wYLa)hv]JML-*H0(g\h=K?0wtfHhrcGDoJp[0Sg]\jzk'm5bπU"=FV;9Q,E9v8h,Tfvmt%sXd%90URYGOzVWB%LQr/WI#gh:sFZpaLf()Ja#[%Ky/YπU"+2QL]nO)]\Fu%HTBx2._AU;f35s+cUt]qrs9aN=$.1\Ayo>2FNeg_=tnZ:td=w)πEND SUBπSUB V3πU"\$r8C;CmMVh:=43_uqIfe3x^a03t7Ol1b9^ANq<AGGAE#l)O.P^2jcMq*41GJ;?πU"eX$4B/_>L8GmZmFio%<C?E#6Ls7h_MIluwkvhXd]R*o<O_T^m8:*pD5;4:;T_A;πU"LZ[:rLq3.VtGPva[ruCq7TWYTJ9VH-):WJbH-gr*#C<ipXXCi;;Qg>#uYl&)k[VπU"2?'iI*i[Df)7<NKV5Z-*cQA+Zofn<ujMqXz%e'v1PQ'9Rw,qW-:7'T,9\hFJPGwπU":vm$f5OZaSG>F-Nps>Sou:d?[['-eu[s>P2HQ'E0Af&b#uWVL<S8<Cq8/XuLpXaπU"SM9G8BBRZXg9WM8s^vigHf>dXuP'f(nKP,JekqN4R^bxG6rw26(1f8hgr4zaXl<πU":,aNT8%.?6v5IlrYfRAlGp[z4-lSU,t^_Mh8t7^y[[e,-OY;J5bzQBF)vn71'<eπU"lz7qeU8AP1t1F'a,DoeZ<mNG1+l5tRHf[\\lsx?5Rb3WE1kP/p/:]mh_1*4kTLzπU"0EiAWNDHQT??ZN4TqH%'MVijEve5Cp.eN=.uJHVGeWQp#H-oM))A/_cmAR#wqP6πU"(-QHTf=]sKKTvUBJ8roa\gFdN%]?:lb(\cGr>g)G1/'gUrj,n>An=gmS]s-^a$\πU"a3$H=ZHuJX6#\fXK[V+d>_FOor#GIx.MF]wKRj7XVu_:((g8S.GHAkLf19][MuuπU"=$'kaZ1FpBSCP0NlO<TANZM.3ml>.W7KX(q^f$\1[tW^g_s.Y7ecmbCL\$x1\]+πU"fE=dl_RNu%dup(%)9%%[%-%BH6bE#ZQNCg[(%%4%4%%-%%%%x%zgxS[gfxFh&:>πU"S7m9vaOmuVj[OFTK$k=j=\q)A>+/:M*MDFzMO=epE'iPC$=Jvn$D2;YEG;;HdeEπU"Iq2VmJHL/l$E3>JCvm%CmU>iC2SIl*c''807iBC=,tYYT<W7^'.On.TRMOBTcVfπU"7G$3>1M&2=#bMbxgdH_Q'r1xDr)6q3CjKh44_C7Q?XDxo*iDInSL9dwJ]kYTt1ZπU"qe]v;htO_2U>cQi2t=Le0]TS=LH%#F3mjF)L<().L5Ou[P]FN1Cphc7OfL<gbfbπU"^RM+Bf+cRm>_77)2+AkF.u56b^m]ESS7CQf*Bo:EMB'U=jaOMchSZ*q8rBn+eg:πU"04%X=^XR^ZllmH0$W<Vi$+Ye<0'e4U8s;>>to&d=>7C[N$EQF.+N]OPX,LOXs3>πU"6;+V;:Qp+Y8UBl#FoZmPS3NC7C%:^?6Uu'o-[p8*)<%\9.%<9;d0)DwB%DF#HNOπU"Rk-)\'$9exOqZ8V+?-7%X$MYBn&%I4D?q_uN\l=H%HiIuh297)cjsDXX-Zakc1NπU"wRr&dCL^<eJ1unN':nm\R(i>Mn4>v;>V1uI&(8gDjba$cyqT_%UOKcmrq&/-'2SπU"T#^P2(EyU2%o).jR2U^7aHNQG&d-,;y54hqD2?X;0Pf8(T%W.D4_a)Gu>oyj>f]πU"dg=+T8^rfX+FwOMB;(5bVV4\/8Io^32-%%rv?b/N75r:ZWH,ss\FDE<-0-$h;=1πU"T)'m86'wHDjY?JL4';9XZ\lXg0?DU*o,3E1ps4/e5#wf%YB;ttQ]Z_%2,.E,K<qπU">d#&yXX#ebMDc2XgZ\*3n\w7b?23G\UT?3)P45W]16*fphsEV%XC(s.QFbNqUf#πU"xjlRvNSH3xnZ4=7d(u8/k:>c<(/a5r6,d<a-%3>YJvLT4)lqz>^r\%#gtoE[-+*πU"T_1\B'xR6j1X1BodVE+F5#uW#Y?OcOUFiYNMsxdZ5Gbx\hne_FtE+TYMC$JUXvIπU"hhSK^tV=rd=grlr4oYZ;gAD;FT^_>wQ71+hVZ5J9<s]5$dLTQCi.L.zxRFvNA$2πU"9(jlg9.IHa?L^#K.d)Zhqv>1$<G1gQ&sIkC:.Y%p/r<SXqn=SY'ldLh;VHQ+7%5πU"B,JJg3\Jt4$.5c(hvZ3rLF)fIGfT0EZJ:uwH5s1't5J_;4usJADL0AOcd1Ms)KWπU")RaFIdm4TDNu%p()9%%%%-g%V*$pE^Zq-TF&%(%1(%%%-%%%%xzg%xSugjz&aF&πU":8f=W?nR^Ju+</[(jpR%;Y6.R)oS-[iFr,*.7zmK.*pTkagt-:2t]=KoHPShOfQπU"x7k65.JihQ%gtaN9i\UOmfIh=\i4b<UtkflGZeGtJ2nF6;<_o=U=THL%[EVnBr6πU")F\Sns*\*7.?6C+(ahfAQiT.ya$gUrsTq9$w439=N?yd<o/A]hhFLJg-,8B<Bh7πU"IEu#S=W);_C$BA:n+D%3k<TD#;D<P;eAM+4P9rSUIZoQ9p]p.hV?+cFVz%F9j7&πU"UHTrmF45.]mp<)nj%IrEQ(Vw9&u5yq>2+gd1cI2\\;b4P\Pt.'*If/\zDcIs;_iπU"=J8+Ni5t_b-B;)=Mg9$]3F1DQ96W.[tf&g,Q\&7Fm\VmD1nA.)#TY$e3l[loWhkπU"vrZt6hjvslO8:7Pt[LdHGKnrTu^AznafpTMo<7_L#DBa;)NflX3gbq>63v5G1]6πU"+cW28&5_k4V;'o;q?GXzlP>B,$U4IhXb\aaS:6Uxmkz;lAMqA$n[u8Ro-xem6L*πU"rleRnd'_DvT.Fnp]XO8b&It9y[Y_iL]i7AB9??aEUj?<B^P-VorwgheWG,ug[*/πU"#r,\8up%&'9%%9%%%[-%n6KbE\g:D/K;d%%0W%%%-%%%%%%%%%&%%E%%%%%%%%%πU"rfsi%Sfxr%up&'%9%9%%%%-%:A6$E%?GlB&r)%%%H0%%%-%%%%%%%%%%%E%7%%qπU";%%%rf%siSt%goup%&'9%%9%%%d-%A60bEI&56Q^(7%%h/%%%.%%%%%%%%%&%%EπU"%%%':#%%%rfsi%USgf%xup&%'9%9%%%%-g%E*$sE>Rd%UD&%+%Y(%%%.%%%%%%%πU"%%&%E#%%%F%D%%r%fsiU%Snsh%up&'%9%9%%%%-%>U6bE4]5T#&_(%%'d/%%%.%πU"%%%%%%%%&%E%7%%6E%%%rf%siVS%gfxu%p&'9%%9%%%%-%',+$EZ*pL%M[&%%S%πU"(%%.%%%%%%%%%&%%E%%(%CI%%%rfs%iVSn%shup%&'9%%9%%%d-%^6BbE<V6%(_πU"(7%%f/%%%.%%%%%%%%%&%%E%%%'<J%%%rfsi%WSgf%xup&%'9%9%%%%-j%p+$+EπU"8mj'pN&%+%Q(%%%.%%%%%%%%%&%E#%%%I%N%%r%fsiW%Snsh%up&'%9%9%%%%-%πU">f6bEY)Tf.&_(%%'d/%%%.%%%%%%%%%&%E%7%%CO%%%rf%siXS%gfxu%p&'9%%9πU"%%#%-%#b,$Er(^s]N[&%%S%(%%.%%%%%%%%%&%%E%%(%PS%%%rfs%iXSn%shup%πU"&'9%%9%%%d-%s6BbE:K1OP_(7%%d/%%%.%%%%%%%%%&%%E%%%'JT%%%rfsi%YSgπU"f%xup&%'9%9%%%%-j%L,$gEDKu%\N&%+%S(%%%.%%%%%%%%%&%E#%%%W%X%%r%fπU"siY%Snsh%up&'%9%9%%%%-%?&6bEoiyrl&$(%%'f/%%%.%%%%%%%%%&%E%7%%QYπU"%%%rf%siZS%gfxu%p&'9%%9%%%%-%tG-$Ey%h9YO[&%%S%(%%.%%%%%%%%%&%%EπU"%%(%_]%%%rfs%iZSn%shup%&'9%%9%%%I-%E*f$Em\5zKl+.%%%4%%%/%%%%%%%πU"%%%%%E%%%'Z^%%%rfsi%jqSu%gqup%&'9%%9%%%m-%s79aEFZ/1m&57%%AK%%%/πU"%%%%%%%%%&%%E%%%&ue%%%wjfi%rjSV%xyup%&'9%%9%%%m-%B6fbE#Q6NCg(7%πU"%44%%%-%%%%%%%%%&%%E%%%%Jv%%%xzgx%Sgfx%up&'%9%9%%%%-%;V*$Et^ZqTπU"'F&%%&1(%%%-%%%%%%%%%%%E%7%%\y%%%xz%gxSu%gzup%*+%%%%%7%77%U(R%%πU"O%%%%%%πEND SUBπV2πV3πCLOSE:IF S=234AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJonathan Leger FAST MEMCOPY ROUTINE leger@mail.dtx.net 07-11-96 (10:14) QB, QBasic, PDS 204 10399 MEM.BAS '***************** MEM.BAS **************************************************π'*** These routines were written by Jonathan Leger: ***π'*** ***π'*** leger@mail.dtx.net ***π'*** http://www.dtx.net/~leger/ ***π'*** ***π'*** PLEASE write to me with your questions. I would appreciate any ***π'*** feedback or machine language ideas for the expansion of Qbasic. ***π'*** What can other compilers do that Qbasic can't? What can PowerBASIC ***π'*** or QuickBASIC do that Qbasic can't? Maybe we can make it work using ***π'*** Machine Language routines that will blow away the other compilers ***π'*** in speed... lemme know! Write to me at the above e-mail address. ***π'*** If you'd like to know how the ML routines work, write me and I'll ***π'*** give you a step-by-step explanation. ***π'****************************************************************************ππDEFINT A-ZππDECLARE SUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)πDECLARE SUB FillChar (segment%, offset%, value%, bytes%)ππ'$STATIC '*** "REM $STATIC" keeps our buffer from moving around in memoryπ' '*** for more info, see the manual or the HELP screen.ππ'*** Dim a 64,000 byte buffer to hold the screen image (an integer isπ'*** 2 bytes, so 32000 * 2 = 64000, the size of a SCREEN 13 image).πDIM buffer(1 TO 32000) AS INTEGERπ'$DYNAMICππ'*** Go to screen 13.πSCREEN 13ππ'*** Clear the screen using color 200 (sorta bluish-purple)πFillChar &HA000, 0, 200, &HFA00ππ'*** Draw some circles on the screen.πFOR x = 1 TO 100π CIRCLE (159, 99), x, xπNEXT xππ'*** Copy the image (which is 64,000 (FA00) bytes and starts at memcoyπ'*** locat A000) and dump its contents into buffer().πMemCopy &HA000, 0, VARSEG(buffer(1)), VARPTR(buffer(1)), &HFA00ππLOCATE 7, 7: PRINT "This image has been dumped"πLOCATE 8, 5: PRINT "Into a 64,000 byte buffer() array."πLOCATE 9, 8: PRINT "Press a key to reload it."ππWHILE INKEY$ = "": WENDππ'*** Clear the screen using color 150 (sorta deep blue)πFillChar &HA000, 0, 150, &HFA00ππLOCATE 2, 1πPRINT "I'm putting this here to prove that I"πPRINT "actually cleared the screen. ;) It"πPRINT "Also demonstrates the speed of the"πPRINT "FillChar() routine which was used to"πPRINT "clear the screen in this spiffy"πPRINT "color."πPRINT : PRINT "Press another key to reload the image."ππWHILE INKEY$ = "": WENDππ'*** Dump the contents of the buffer back onto the screen.πMemCopy VARSEG(buffer(1)), VARPTR(buffer(1)), &HA000, 0, &HFA00ππLOCATE 1, 2: PRINT "Tada! So fast you don't believe it. ;)"ππWHILE INKEY$ = "": WENDπSCREEN 0: WIDTH 80ππREM $STATICπ'*****************************************************π'*** FillChar() ***π'*****************************************************π'*** FillChar() puts whatever is in value% (which ***π'*** should be a number from 0-255) into memory ***π'*** starting at location segment:offset, ending ***π'*** at location segment:offset+bytes%. An good ***π'*** example of its use would be for clearing the ***π'*** screen with a different background color in ***π'*** a graphics screen (which is pitifully slow ***π'*** usint PSET). To do this for SCREEN 13, for ***π'*** example: ***π'*** ***π'*** FillChar &HA000, 0, 15, &HFA00 ***π'*** ^ ^ ^ ^ ***π'*** | | | | ***π'*** Screen 13--+ | | | ***π'*** | | | ***π'*** Start with first | | | ***π'*** pixel.------------+ | | ***π'*** | | ***π'*** Fill with character/ | | ***π'*** color 15--------------+ | ***π'*** | ***π'*** Do so 64,000 times---------+ ***π'*** ***π'*** This will "clear" SCREEN 13 with the color 15 ***π'*** (bright white), and it does so _faster_ than ***π'*** the CLS routine clears SCREEN 13 in black. ***π'*** ***π'*** Notice that the 64,000 is in HEX (FA00). This***π'*** is the same as with MemCopy(), where a value ***π'*** greater than 32,767 has to be put into hex. ***π'*** Since BASIC integers are signed (can be plus ***π'*** or minues 32,767), BASIC does not let you use ***π'*** 65,534 (64k) in an integer, and there is no ***π'*** way to declare a variable as an unsigned int- ***π'*** eger. Machine Language, however, does not ***π'*** recognize the plus or minus of a number unless***π'*** you tell it to, so by using the HEX value, we ***π'*** can trick BASIC into passing a number larger ***π'*** than 32767 to the Machine Language routine, ***π'*** which will treat &HFA00 as 64000 (even though ***π'*** if you do a PRINT &HFA00 it returns -1536). ***π'*****************************************************πSUB FillChar (segment%, offset%, value%, bytes%)ππasm$ = ""πasm$ = asm$ + CHR$(85) 'PUSH BPπasm$ = asm$ + CHR$(137) + CHR$(229) 'MOV BP,SPπasm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6) 'MOV CX,[BP+06]πasm$ = asm$ + CHR$(139) + CHR$(86) + CHR$(8) 'MOV DX,[BP+08]πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12) 'MOV AX,[BP+0C]πasm$ = asm$ + CHR$(30) 'PUSH DSπasm$ = asm$ + CHR$(142) + CHR$(216) 'MOV DS,AX πasm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(10) 'MOV BX,[BP+0A] πasm$ = asm$ + CHR$(136) + CHR$(23) 'MOV [BX],DL <------+πasm$ = asm$ + CHR$(67) 'INC BX |πasm$ = asm$ + CHR$(226) + CHR$(251) 'LOOP 0112 -------+πasm$ = asm$ + CHR$(31) 'POP DSπasm$ = asm$ + CHR$(93) 'POP BPπasm$ = asm$ + CHR$(203) 'RETFππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL segment%, BYVAL offset%, BYVAL value%, BYVAL bytes%, SADD(asm$))πDEF SEGππEND SUBππ'*************************************************************π'*** MemCopy() ***π'*************************************************************π'*** This routine will copy the number of bytes specified ***π'*** in the Bytes% variable from the segment:offset in ***π'*** fromseg%:fromoffset% to the segment:offset given in ***π'*** toseg%:tooffset%. To copy more than 32767 bytes, ***π'*** put the HEX value in Bytes% instead of the decimal ***π'*** value. For example, in HEX, 64000 is FA00 (prepended ***π'*** by an &H in BASIC, to make it &HFA00), so if you were ***π'*** to copy a 64,000 byte screen 13 image, you would do: ***π'***********************************************************************π'*** MemCopy &HA000, 0, VARSEG(buffer(0)), VARPTR(buffer(0)), &HFA00 ***π'*** ^ ^ ^ ^ ^ ***π'*** | | | | | ***π'*** Screen 13-+ | | | | ***π'*** | | | | ***π'*** Start copying at+ | | | ***π'*** the first pixel-+ | | | ***π'*** | | | ***π'*** Segment of our 64k buffer+ | | ***π'*** | | ***π'*** Offset of our 64k buffer --------------------+ | ***π'*** | ***π'*** Copy 64,000 bytes (HEX = FA00, BASIC = &HFA00) ------------+ ***π'***********************************************************************π'*** For a full explanation of why we must use HEX instead of decimal***π'*** for values greater than 32,767, see the remarks in the FillChar ***π'*** routine. ***π'***********************************************************************π' This routine was written by Jonathan Leger, and if you use it,π' please let me know. I'd like to know if this code is gettingπ' any practical use. I've wanted to emulate PowerBASIC's POKE$π' and PEEK$ for a _long_ time (also Pascal's Mem[] routine), andπ' this is my first stab at it, which worked out very well and isπ' very fast since it's in pure machine language (it was writtenπ' in DOS' Debug! =).π'***********************************************************************πSUB MemCopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)ππasm$ = ""πasm$ = asm$ + CHR$(85) 'PUSH BPπasm$ = asm$ + CHR$(137) + CHR$(229) 'MOV BP,SPπasm$ = asm$ + CHR$(30) 'PUSH DSπasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10) 'MOV AX,[BP+0A]πasm$ = asm$ + CHR$(142) + CHR$(192) 'MOV ES,AXπasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14) 'MOV AX,[BP+0E]πasm$ = asm$ + CHR$(142) + CHR$(216) 'MOV DS,AXπasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8) 'MOV SI,[BP+08]πasm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(12) 'MOV DI,[BP+0C]πasm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6) 'MOV CX,[BP+06]πasm$ = asm$ + CHR$(243) 'REPZπasm$ = asm$ + CHR$(164) 'MOVSBπasm$ = asm$ + CHR$(31) 'POP DSπasm$ = asm$ + CHR$(93) 'POP BPπasm$ = asm$ + CHR$(203) 'RETFππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, SADD(asm$))πDEF SEGππEND SUBπTony Lieuallen GROWING FIRE marvin@mars.superlink.net 07-05-96 (16:18) QB, QBasic, PDS 86 2053 FIRE.BAS 'Fire!! By Tony Lieuallen. E-mail: marvin@mars.superlink.netπ'This is a demo I made (Evolved slowly from the file in the PC Gamesπ'Programmers Encyclopedia) in my free time. In the rem's is what youπ'would have to do to make it run in PB (originally written for QuickBasic).π'I like values of XMax=200 YMax=100 X and YStart=50.ππDEFINT A-ZππSCREEN 13π' in PB make this:π' (or is that ah?)π'! mov ax, &H13π'! int &H10ππRANDOMIZE TIMERπIF COMMAND$ <> "" THENπ T$ = COMMAND$π XMax = VAL(LEFT$(T$, INSTR(T$, " ")))π T$ = RIGHT$(T$, LEN(T$) - INSTR(T$, " "))π π YMax = VAL(LEFT$(T$, INSTR(T$, " ")))π T$ = RIGHT$(T$, LEN(T$) - INSTR(T$, " "))π π XStart = VAL(LEFT$(T$, INSTR(T$, " ")))π T$ = RIGHT$(T$, LEN(T$) - INSTR(T$, " "))π π YStart = VAL(T$)πELSEπ INPUT " XMax=", XMaxπ INPUT " YMax=", YMaxπ INPUT "XStart=", XStartπ INPUT "YStart=", YStartπEND IFπCLSππCMax = 150πRed = 0πGrn = 0πBlu = 0πCC = 1ππFOR X = 1 TO CMaxπ SELECT CASE CCπ CASE 1π Red = Red + 1π IF Red = 60 THEN CC = 2π CASE 2π Grn = Grn + 1π IF Grn = 60 THEN CC = 3π CASE 3π Grn = Grn - 2π Red = Red - 1π END SELECTπ OUT &H3C8, Xπ OUT &H3C9, Redπ OUT &H3C9, Grnπ OUT &H3C9, BluπNEXTππDEF SEG = &HA000πDOπ IF INKEY$ <> "" THENπ COLOR 180π SYSTEMπ END IFπ FOR Count = 1 TO XMax \ 1.5π Y& = (YMax - 1 + YStart)π 'In PB make all the "poke"s "pokeb"sπ POKE (320 * Y& + (INT(RND * XMax) + XStart)), INT(RND * CMax)π POKE (320 * (Y& - 1) + (INT(RND * XMax) + XStart)), INT(RND * CMax)π NEXTππ P = 0π FOR Y1 = 2 TO YMax - 1π FOR X1 = 2 TO XMax - 1π X& = (X1 + XStart)π Y& = (Y1 + YStart)π P = PEEK(320 * Y& + (X& + 1))π P = P + PEEK(320 * Y& + (X& - 1))π P = P + PEEK(320 * (Y& + 1) + X&)π P = P + PEEK(320 * (Y& - 1) + X&)π P = P \ 4π POKE (320 * (Y& - 1) + X&), Pπ NEXTπ NEXTπLOOPπAndy J. Golden CHAOS YHBV44B@prodigy.com 07-12-96 (22:42) QB, QBasic, PDS, PB 26 565 CHAOS.BAS 1 ' CHAOS.BASπ10 KEY OFF: CLSπ20 SCREEN 2π30 DEFSNG A-Zπ40 COLUMNS = 640π50 ROWS = 200π60 START = 1π70 FINISH = 3.999π80 TOP = 0π90 BOTTOM = 1π100 MAXREPS = 10π110 HEIGHT = BOTTOM - TOPπ120 VPCT = 1 / HEIGHTπ130 FOR R = START TO FINISH STEP ((FINISH - START) / COLUMNS)π140 X = .1π150 FOR I = 1 TO 100π160 X = R * (X - X * X)π170 NEXT Iπ180 FOR I = 1 TO 30π190 X = R * (X - X * X)π200 XPOS = (R - START) * COLUMNS / (FINISH - START)π210 YPOS = ROWS - (X - TOP) * ROWS * VPCTπ220 PSET (XPOS, YPOS)π230 NEXT Iπ240 NEXT Rπ250 A$ = INPUT$(1)πAndy J. Golden FRACTAL FERN YHBV44B@prodigy.com 07-12-96 (22:42) QB, QBasic, PDS, PB 26 566 IFSFERN.BAS ' IFSFERN.BASπSCREEN 2πCLSπVIEW (0, 0)-(639, 199)πWINDOW (-4, 0)-(6, 10)πRANDOMIZE TIMERπX = 0πY = 0πWHILE INKEY$ = ""πR = RNDπIF (R <= .01) THENπ A = 0: B = 0: C = 0: D = .16: E = 0: F = 0πELSEIF R > .01 AND R <= .86 THENπ A = .85: B = .04: C = -.04: D = .85: E = 0: F = 1.6πELSEIF R > .86 AND R <= .93 THENπ A = .2: B = -.26: C = .23: D = .22: E = 0: F = 1.6πELSEπ A = -.15: B = .28: C = .26: D = .24: E = 0: F = .44πEND IFπNEWX = (A * X) + (B * Y) + EπNEWY = (C * X) + (D * Y) + FπX = NEWXπY = NEWYπPSET (X, Y)πWENDπSCREEN 0πChad Beck PUT W/O ERASING BACKGROUND FidoNet QUIK_BAS Echo 06-27-96 (00:00) QB, QBasic, PDS 71 3091 PUT.BAS ' [= As two common people in New York would say, let's start rambling =]ππ'> Wait a minute. Is the above an example of BLOADing a image? I think I haveπ'> the idea of how to get the sprite to the screen.ππ'That's an idea. Draw a bunch of sprites, use PICEM to display it and thenπ'code to save it in BLOAD format as maybe something like SPRITE.BLD. Thenπ'the program can load it in another page not displayed, and GET the spritesπ'into buffers while displaying a "please wait" message on the viewable page?π'Just ideas I was thinking up while reading this.ππ'> Now for the big question "Can you tilt the picture after drawing it?".ππ'Well, if you GET the dartboard into a buffer somehow (assuming you can createπ'one large enough) I guess you can PUT it differently? Or what about this: Youπ'scan the visable page for each pixel, and replot it slightly differently toπ'an angle on a non-visiable page, then flip to that page and its tilted! Orπ'do this on two non-visiable page while the "please wait" message is on theπ'visiable page? We may have to use the 320 x 200 mode, as don't that have theπ'most pages to work with? I am not sure on the concept of this virtual pageπ'thing, but it may be a key to this and other neat display tricks.ππ'As for animating, I heard of page-flipping techniques. Also you can do someπ'neat things with the PUT statement:ππ'From: Chad Beckπ'Subj: PUTsππ' > I think it was CHAD BECK who earlier posted how to PUT a bitmap toπ' > the screen using XOR and AND to not distort the background. If youπ' > could be so kind, could you repost it!? Thanks...ππ' Actually it uses AND & OR.π' The ANDed image (which is PUT first) should be an inverse ofπ'original, whereby color zero is used for the solid areas and the highestπ'color in the palette (mode dependant) is used for the transparent areas.π' Here's the demo from an old mail pack. The pair of images used toπ'draw each sprite are left in the upper left-hand corner of the screen forπ'your inspection.ππ'-----------------------------------------------------------------------πDEFINT A-ZππSCREEN 13πPALETTE 255, 1024 * 15 'Change color 255 so it's visibleπDIM Image(0 TO 33), Scr(0 TO 33)ππInColr = 4 'The inner color of the circleπOutColr = 3 'The color of its outer ringπCIRCLE (5, 5), 4, OutColr 'Draw original image--make transparentπPAINT (5, 5), InColr, OutColr ' areas Color 0πGET (1, 2)-(9, 8), ImageππLINE (16, 2)-(24, 8), 255, BF 'Draw its compliment--Color 0πCIRCLE (20, 5), 4, 0 ' for solid areas, Color 255 (or 15 inπPAINT (20, 5), 0, 0 ' EGA modes) for transparent areasπGET (16, 2)-(24, 8), ScrππFOR Repeat = 1 TO 9 'Draw a background patternπ LINE (0, 20 * Repeat)-(320, 200), Repeat + 20, BFπNEXTππFOR Repeat = 1 TO 100 'Draw the spritesπ X = RND * 310π Y = RND * 190π PUT (X, Y), Scr, ANDπ PUT (X, Y), Image, ORπNEXTππDO: LOOP UNTIL LEN(INKEY$) 'Wait before quittingππKurt Kuzba HAPPY TRAILZ FidoNet QUIK_BAS Echo 02-10-96 (00:00) QB, QBasic, PDS 72 2907 HPTRAILZ.BAS'_|_|_| HPTRAILZ.BASπ'_|_|_| Happy Trailz. This program demonstrates one methodπ'_|_|_| of creating a series of self-overwriting lines toπ'_|_|_| keep the CPU happy when there is nothing else to do.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (2/10/96)πDECLARE SUB HappyTrails (l%)πTYPE LNZπ x1 AS INTEGER: x2 AS INTEGER: y1 AS INTEGER: y2 AS INTEGERπEND TYPEπl$ = COMMAND$ '_|_|_| REM this out if using QBasicπIF VAL(l$) < 1 THEN l$ = "4"πl% = VAL(l$)πIF l% > 20 THEN l% = 20πIF l% < 2 THEN l% = 2πHappyTrails l%πSUB HappyTrails (l%)π DIM la(1 TO l%, 11) AS LNZ, C(6) AS INTEGER, K(6) AS INTEGERπ DIM dx1(1 TO l%) AS INTEGER, dx2(1 TO l%) AS INTEGERπ DIM dy1(1 TO l%) AS INTEGER, dy2(1 TO l%) AS INTEGERπ C(0) = 15: C(1) = 11: C(2) = 3: C(3) = 9: C(4) = 1: C(5) = 0π K(0) = 14: K(1) = 13: K(2) = 12: K(3) = 4: K(4) = 5: K(5) = 0π RANDOMIZE (TIMER + INP(64))π FOR ln% = 1 TO l%π dx1(ln%) = 9: dx2(ln%) = 9: dy1(ln%) = 9: dy2(ln%) = 9π FOR fade% = 0 TO 10π la(ln%, fade%).x1 = 320 + fade% * 2π la(ln%, fade%).y1 = 240 + fade% * 2π la(ln%, fade%).x2 = 320 - fade% * 2π la(ln%, fade%).y2 = 240 - fade% * 2π NEXTπ NEXT: SCREEN 12π Ky$ = INKEY$π WHILE Ky$ = ""π FOR ln% = 1 TO l%π WHILE (INP(&H3DA) AND 8) = 0: WENDπ WHILE (INP(&H3DA) AND 8) <> 0: WENDπ Ky$ = INKEY$: IF Ky$ <> "" THEN EXIT FORπ FOR fade% = 10 TO 1 STEP -1π x1% = la(ln%, fade%).x1: y1% = la(ln%, fade%).y1π x2% = la(ln%, fade%).x2: y2% = la(ln%, fade%).y2π la(ln%, fade%).x1 = la(ln%, fade% - 1).x1π la(ln%, fade%).y1 = la(ln%, fade% - 1).y1π la(ln%, fade%).x2 = la(ln%, fade% - 1).x2π la(ln%, fade%).y2 = la(ln%, fade% - 1).y2π IF (ln% AND 1) = 0 THENπ LINE (x1%, y1%)-(x2%, y2%), C(fade% \ 2)π ELSEπ LINE (x1%, y1%)-(x2%, y2%), K(fade% \ 2)π END IFπ NEXTπ x1% = la(ln%, 0).x1 + dx1(ln%): y1% = la(ln%, 0).y1 + dy1(ln%)π x2% = la(ln%, 0).x2 + dx2(ln%): y2% = la(ln%, 0).y2 + dy2(ln%)π IF x1% > 639 THEN dx1(ln%) = -(RND * 7 + 9): x1% = 639π IF x1% < 0 THEN dx1(ln%) = RND * 7 + 9: x1% = 0π IF x2% > 639 THEN dx2(ln%) = -(RND * 7 + 9): x2% = 639π IF x2% < 0 THEN dx2(ln%) = RND * 7 + 9: x2% = 0π IF y1% > 479 THEN dy1(ln%) = -(RND * 7 + 9): y1% = 479π IF y1% < 0 THEN dy1(ln%) = RND * 7 + 9: y1% = 0π IF y2% > 479 THEN dy2(ln%) = -(RND * 7 + 9): y2% = 479π IF y2% < 0 THEN dy2(ln%) = RND * 7 + 9: y2% = 0π la(ln%, 0).x1 = x1%: la(ln%, 0).y1 = y1%π la(ln%, 0).x2 = x2%: la(ln%, 0).y2 = y2%π IF (ln% AND 1) = 0 THENπ LINE (x1%, y1%)-(x2%, y2%), C(0)π ELSEπ LINE (x1%, y1%)-(x2%, y2%), K(0)π END IFπ NEXTπ WENDπ SCREEN 0πEND SUBπ'_|_|_| end HPTRAILZ.BASπKurt Kuzba ROTATING A BIG PALETTE SMOOTHLYFidoNet QUIK_BAS Echo 04-07-96 (00:00) QB, QBasic, PDS 86 3329 BIGPALET.BAS'> Can anyone tell me how to access the 256K colors that I'mπ'> supposed to have on my VGA graphics? I would like to putπ'> some color cycling and the like into my graphics, yet Iπ'> can't find a way to get beyond the basic 15 even in screenπ'> modes 11,12, etc.π'>.............................................................π' In mode 12h, which is a 16 color mode, you will be able toπ'only use 16 selected colors. You may choose which of the 256π'standard defined colors you will use, or even make your own, butπ'you will still be limited to 16 colors of your choice.ππ'_|_|_| BIGPALET.BASπ'_|_|_| This is a simple demonstration of a technique rotatingπ'_|_|_| a big palette smoothly in graphics mode 13h.π'_|_|_| No warrantees or guarantees are given or implied.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (4/7/96)πDECLARE SUB RotatePalette (t%)πDECLARE SUB PalPocket (save%)πDECLARE SUB MakePalette ()π'$DYNAMICπDIM SHARED PAL(384) AS INTEGER: DIM SHARED RGB(16050) AS LONGπSCREEN 13: PalPocket 1: SOUND 999, 3: MakePaletteπFOR t% = 200 TO 1 STEP -1π CIRCLE (60 + t% \ 2, 50 + t% \ 4), t%, 201 - t%π PAINT (60 + t% \ 2, 50 + t% \ 4), 201 - t%: NEXT: t% = 0πWHILE INKEY$ = ""π' WHILE (INP(&H3DA) AND 8) = 0: WEND ' Uncomment these linesπ' WHILE (INP(&H3DA) AND 8) <> 0: WEND ' if compiling to .EXEπ' WHILE (INP(&H3DA) AND 8) = 0: WEND ' They are for smoothπ' WHILE (INP(&H3DA) AND 8) <> 0: WEND ' rotation if compiledπ RotatePalette t%: t% = (t% + 1) MOD 21400πWEND: PalPocket 0: SCREEN 0: WIDTH 80, 25: ENDπSUB MakePaletteπ DEF SEG = VARSEG(RGB(0)): O& = VARPTR(RGB(0))π r% = 0: g% = 0: b% = 0: rd% = 1: gd% = 1: bd% = 1π FOR t& = 0 TO 21399π p& = O& + t& * 3π IF (r% < 64) AND (r% >= 0) THENπ POKE p&, r%π ELSEπ IF r% < 0 THEN POKE p&, 0π IF r% > 63 THEN POKE p&, 63π END IFπ IF (g% < 64) AND (g% >= 0) THENπ POKE p& + 1, g%π ELSEπ IF g% < 0 THEN POKE p& + 1, 0π IF g% > 63 THEN POKE p& + 1, 63π END IFπ IF (b% < 64) AND (b% >= 0) THENπ POKE p& + 2, b%π ELSEπ IF b% < 0 THEN POKE p& + 2, 0π IF b% > 63 THEN POKE p& + 2, 63π END IFπ IF r% = 70 THEN rd% = -1: ELSE IF r% = -8 THEN rd% = 1π IF g% = 73 THEN gd% = -1: ELSE IF g% = -11 THEN gd% = 1π IF b% = 76 THEN bd% = -1: ELSE IF b% = -14 THEN bd% = 1π r% = r% + rd%: g% = g% + gd%: b% = b% + bd%: NEXTπEND SUBπSUB PalPocket (save%)π DEF SEG = VARSEG(PAL(0)): O& = VARPTR(PAL(0))π IF save% <> 0 THENπ FOR t% = 0 TO 255π OUT &H3C7, t%π POKE O& + t% * 3 + 0, INP(&H3C9)π POKE O& + t% * 3 + 1, INP(&H3C9)π POKE O& + t% * 3 + 2, INP(&H3C9): NEXTπ ELSEπ FOR t% = 0 TO 255π OUT &H3C8, t%π OUT &H3C9, PEEK(O& + t% * 3 + 0)π OUT &H3C9, PEEK(O& + t% * 3 + 1)π OUT &H3C9, PEEK(O& + t% * 3 + 2): NEXTπ END IFπEND SUBπSUB RotatePalette (t%)π DEF SEG = VARSEG(RGB(0)): O& = VARPTR(RGB(0))π FOR att% = 1 TO 255π C& = O& + ((att% + t%) MOD 21400) * 3π OUT &H3C8, att%π OUT &H3C9, PEEK(C&)π OUT &H3C9, PEEK(C& + 1)π OUT &H3C9, PEEK(C& + 2): NEXTπEND SUBπ'_|_|_| end BIGPALET.BASπDouglas Lusher 320X240 MODEX WITH 3 PAGES FidoNet QUIK_BAS Echo 07-20-96 (11:19) QB, PDS 184 5828 320X240.BAS 'Greetings, everyone. Here is code to put a VGA card into 320x240 modeπ'with 256 colors and 3 pages. This should be a good layout for highπ'quality graphics and animation. It has a 4:3 aspect ratio, so the pixelsπ'are square, and it has 20% more pixels than SCREEN 13 and multipleπ'pages. All with 256 colors. Please try it out and send me yourπ'comments and bug reports. Thanks.ππ DECLARE SUB XCLS (Page%)π DECLARE SUB ShowPage (Page%)π DECLARE SUB Set320x240mode ()π DECLARE SUB XPRINT (X%, Y%, Text$, Culler%, Page%)π DECLARE SUB PutPixel (X%, Y%, Culler%, Page%)π DEFINT A-Zπ '$INCLUDE: 'QB.BI'ππ DIM BitMask%(7)π FOR Bit% = 0 TO 7: BitMask%(Bit%) = 2 ^ Bit%: NEXTπ Test$ = "The quick brown fox jumps over lazy dogs"π CALL XPRINT(0, 0, "", 0, 0) 'initialize the print routineππ CALL Set320x240mode: SLEEP 1π HMax% = 320: VMax% = 240: Pg% = 0π FOR X% = 0 TO HMax% - 1π CALL PutPixel(X%, 0, 2, Pg%)π CALL PutPixel(X%, VMax% - 1, 2, Pg%)π NEXTπ FOR Y% = 0 TO VMax% - 1π CALL PutPixel(0, Y%, 2, P%)π CALL PutPixel(HMax% - 1, Y%, 2, Pg%)π NEXTπ CALL XPRINT(0, 0, "This is 320x240x256 mode, 3 pages", 15, P%)π FOR Y% = 1 TO 14π CALL XPRINT(0, Y% * 16, Test$, Y%, Pg%)π NEXTπ BEEP: A$ = INPUT$(1)π CALL XCLS(0)π CALL XPRINT(0, 0, "This is page 0", 1, 0)π CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 1, 0)π CALL XPRINT(0, 80, "Press ESC to exit", 1, 0)π CALL XPRINT(0, 16, "This is page 1", 2, 1)π CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 2, 1)π CALL XPRINT(0, 80, "Press ESC to exit", 2, 1)π CALL XPRINT(0, 32, "This is page 2", 4, 2)π CALL XPRINT(0, 64, "Press 0, 1, or 2 to see the pages", 4, 2)π CALL XPRINT(0, 80, "Press ESC to exit", 4, 2)π DOπ A$ = INPUT$(1)π SELECT CASE A$π CASE "0": CALL ShowPage(0)π CASE "1": CALL ShowPage(1)π CASE "2": CALL ShowPage(2)π CASE CHR$(27): EXIT DOπ CASE ELSE: BEEPπ END SELECTπ LOOPπ SCREEN 13: SCREEN 0: WIDTH 80π ENDππ SUB GetPixel (X%, Y%, Culler%, Page%)π SELECT CASE Page%π CASE 0: VidSegment% = &HA000π CASE 1: VidSegment% = &HA4F0π CASE 2: VidSegment% = &HA9E0π CASE ELSE: ERROR 5π END SELECTπ OUT &H3CE, 4: OUT &H3CF, X% AND 3π DEF SEG = VidSegment%π Culler% = PEEK((Y% * 80) + (X% \ 4))π END SUBππ SUB PutPixel (X%, Y%, Culler%, Page%)π SHARED BitMask%()π SELECT CASE Page%π CASE 0: VidSegment% = &HA000π CASE 1: VidSegment% = &HA4F0π CASE 2: VidSegment% = &HA9E0π CASE ELSE: ERROR 5π END SELECTπ OUT &H3C4, 2: OUT &H3C5, BitMask%(X% AND 3)π DEF SEG = VidSegment%π POKE (Y% * 80) + (X% \ 4), Culler%π END SUBππ SUB Set320x240modeπ 'begin with standard 320x200x256 modeπ SCREEN 13π 'disable "chain4" modeπ OUT &H3C4, &H4: OUT &H3C5, &H6π 'enable writes to all four planesπ OUT &H3C4, &H2: OUT &H3C5, &HFπ 'clear video memoryπ CLSπ 'synchronous reset while switching clocksπ OUT &H3C4, 0: OUT &H3C5, &H1π 'select 25 Mhz dot clock and 60 hz scanning rateπ OUT &H3C2, &HE3π 'restart the sequencerπ OUT &H3C4, 0: OUT &H3C5, &H3π 'to reprogram the CRT controller,π 'remove write protect from the registersπ OUT &H3D4, &H11: OUT &H3D5, INP(&H3D5) AND &H7Fπ OUT &H3D4, &H6: OUT &H3D5, &HD 'total vertical pixelsπ OUT &H3D4, &H7: OUT &H3D5, &H3E 'overflowπ OUT &H3D4, &H9: OUT &H3D5, &H41 'turn off double double-scanπ OUT &H3D4, &H10: OUT &H3D5, &HEA 'vertical sync startπ OUT &H3D4, &H11: OUT &H3D5, &HAC 'vertical sync end, reprotect registersπ OUT &H3D4, &H12: OUT &H3D5, &HDF 'vertical pixels displayedπ OUT &H3D4, &H14: OUT &H3D5, 0 'turn off dword modeπ OUT &H3D4, &H15: OUT &H3D5, &HE7 'vertical blank startπ OUT &H3D4, &H16: OUT &H3D5, &H6 'vertical blank endπ OUT &H3D4, &H17: OUT &H3D5, &HE3 'turn on byte modeπ END SUBππ SUB ShowPage (Page%)π SELECT CASE Page%π CASE 0: OUT &H3D4, &HC: OUT &H3D5, 0π CASE 1: OUT &H3D4, &HC: OUT &H3D5, &H4Fπ CASE 2: OUT &H3D4, &HC: OUT &H3D5, &H9Eπ CASE ELSE: ERROR 5 'illegal function callπ END SELECTπ END SUBππ SUB XCLS (Page%)π SELECT CASE Page%π CASE 0: VidSegment% = &HA000π CASE 1: VidSegment% = &HA4F0π CASE 2: VidSegment% = &HA9E0π CASE ELSE: ERROR 5π END SELECTπ OUT &H3C4, &H2: OUT &H3C5, &HFπ DEF SEG = VidSegment%π FOR Address% = 0 TO 19199: POKE Address%, 0: NEXTπ END SUBππ SUB XPRINT (X%, Y%, Text$, Culler%, Page%)π STATIC HiNibble%(), LoNibble%()π IF LEN(Text$) GOTO StartXPRINTπ REDIM HiNibble%(255, 15), LoNibble%(255, 15)π REDIM BitMask%(15)π BitMask%(0) = 0: BitMask%(1) = 8: BitMask%(2) = 4π BitMask%(3) = 12: BitMask%(4) = 2: BitMask%(5) = 10π BitMask%(6) = 6: BitMask%(7) = 14: BitMask%(8) = 1π BitMask%(9) = 9: BitMask%(10) = 5: BitMask%(11) = 13π BitMask%(12) = 3: BitMask%(13) = 11: BitMask%(14) = 7π BitMask%(15) = 15π DIM Regs AS RegTypeXπ Regs.AX = &H1130π Regs.BX = &H600π CALL InterruptX(&H10, Regs, Regs)π CharSegment% = Regs.ES: CharOffset% = Regs.BPπ DEF SEG = CharSegment%π FOR Char% = 0 TO 255π FOR Ln% = 0 TO 15π BitPattern% = PEEK(CharOffset%)π HiNibble%(Char%, Ln%) = BitMask%(BitPattern% \ 16)π LoNibble%(Char%, Ln%) = BitMask%(BitPattern% AND 15)π CharOffset% = CharOffset% + 1π NEXTπ NEXTπ ERASE BitMask%ππ StartXPRINT:π SELECT CASE Page%π CASE 0: VidSegment% = &HA000π CASE 1: VidSegment% = &HA4F0π CASE 2: VidSegment% = &HA9E0π CASE ELSE: ERROR 5π END SELECTπ OUT &H3C4, 2π DEF SEG = VidSegment%π VidPtr% = (Y% * 80) + (X% \ 4)π FOR Ptr% = 1 TO LEN(Text$)π Char% = ASC(MID$(Text$, Ptr%, 1))π VidOffset% = VidPtr%π FOR Ln% = 0 TO 15π OUT &H3C5, HiNibble%(Char%, Ln%)π POKE VidOffset%, Culler%π OUT &H3C5, LoNibble%(Char%, Ln%)π POKE VidOffset% + 1, Culler%π VidOffset% = VidOffset% + 80π NEXTπ VidPtr% = VidPtr% + 2π NEXTπ END SUBπBen Lloyd PROG-DRAW 2.2 foxeggs@newrock.com 08-03-96 (10:55) QB, QBasic, PDS 114 7405 PROGDRAW.BAS' Remember to extract the .ZIP with option -Dπ' ie. PKUNZIP -D PROGDRAW.ZIP C:\ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"PROGDRAW.ZIP",4^6:Z&=5217:?STRING$(50,177);πU"%up()%9%%%.%%:0'wE%%%%%%%%%%%%%%%3%%%%uw%tliw(f&Ti.wf&T%up()%/%πU"%%I%%=%%(F%%%%%%%%%%%%%%%9%%%%uw%tliw(f&Ti.wf&i%fySu(i&up%()/%%πU"%%%%)=%(F%%%%%%%%%%%%%%%%9%%%%uwtl#iwf&%Tity#iwf&#Sui&%up()%9%%πU"%7-%;w9vE98&7IL%%%%O%%%%:%%%%uw%tliw(f&Tu%wtli.wf&S%gfyp$/YnB(TπU"]Nq7oQGq,%ITO'Fx%/R:9^vAv9JeN#OWA(boIT%<%up%()9%%%%-%&UI&F&Er]9πU"'d'%%%N*%%%9%%%%uwtl#iwf&%Tnsx%yfqq.Sy'yS4y:='[U5bL<XNgI#<idPIeπU"8(uA/JKJOgyy2z-[Xm&0#GoSsLe6Ph[x))y:7X/oEJt>W5Y^vr1I_*&fhmi0.,(πU"2SH'A%OeR\u(z<8/$)ka4Y6b#&fPRC.c;utbb]crc9de<ZI^i74\B2AnrL(]7P<πU"d<nqE['rRD)=0CqE]-K'^)ptCLei^C_N(9pqTgcZv3wWUoer1Ht1'dAI-K3&C2FπU"(M,$^L/P::;/1gbVV#\,n\jZ%U92ow$T;l/Q;L51vk%CaW8QThA;n-6ioK$qUeuπU"0=eB^Yw%xskosab=PTfZn-p&]INO4HiB-S,')tvIEjr%/6dIJ]1g<,A*PDWM/:aπU"W_DoZsqBZL+xAdkUq<:GW0g8O+kp)Z\mN/8SxA'Pf.O56[.)'Zs,5a^HEWk\sKcπU"ac_w&CO)?DTLD&)'(XH)Upj5D5oJgF(HpEha,F>r[0mk.l/(3Gz%mfN^uGUc^f0πU"X<(Y>8=#u-NYM60d]pjoFSzLqhH&LBp5%5XG-Bk1;dj/H3:qF4*ePu2j2g.a6$?πU"g9waQ-C0]ZV)Kc^HcT>E-Hp&VY1X--OPcU)*#ak/&U62LR-6*CmQ53('l&scm)RπU"Tl-IHH3_$RP>]V9=k0X(uBW2GPKeA5h6#jxnznGCS2EIb/?6TVg:<k/<JEZGrC.πU"OpgJC[mU2K(Q#awP^6]$rOIJ(Vf1yTgqE^*RUTH&2e/uL_1DKZKOALjlRE;$2<WπU"=Xu[ndlMf'RmO>(%TD]gDlxIoreWE/0tYH-J:+51wyYE2Tu1LuA0J:)[3yAAu?vπU"Re%LiXe]YQ3$Aav<Cf_m>LfTh6FjoIUmp>B1Wv6TPMs:8X=okx3d5q<Xri?iXs2πU"oGC.xG<X_l3ZMt++U]i^1(;4hC(iM1sumTR^bkTf8$rO>G:tUW)[C-kwSAf>P$9πU"RC(8[-OYA3&yF1:;qb6Usk=x4,Gi4u%p()9%%%%-(%Uw&+F+E2&b9%%%%>%%%%6πU"%%%%uwt%liwf&&Tzx%jwSn[snX$o^W[^IW%aU#;e'WI2f;-%S%up%()9%%%%-%%πU"OI&FOt)PU&^2%%%^\%%%7%%%%uwtl#iwf&%Tiwf)&&SgRfxN*rd>T/j;x=9ox(ZπU"&Y7+QlWWM-FDObMX+vPWQM6,PL)#;JZTco'te;V?x?qD<\RNOFU>L1D,k*sl<0lπU"GHmdC_fjW>C5WLvIJ]qy<.DlIB84htqn,6Vw:BPMAyy(MEJJdqcom^+bSJscDPTπU"<VXd]Mv7kqEB;>.f#0\^?i1D3WHA%&urlm[EdMzecHky^?0#NFPzl+[8vxcPtJ_πU"'YrPjDBU'DOrlXpV[h0B'vKr$KClS&85UiVt&BadM3^Tz25H2erNSLGHpjhX]]6πU"F:><$Lcgp<T,oH1k:y[YzcFMB<Z'*5'\JQQ,<j<f7zguQ3)qQA>KQhf#XumgO(oπU"]SE^8,IgyM?E:yI\ZT&h?L.q.rJUgU/R/NL3YuiIfaD;S3t*&8%q.xAsrjo6<5wπU"T:m_D&ab09vfu493WheE4Oi-'VoTm;V/Hfn]*$IWsfbiRAaE6IN3?JrvvZ%[>.&πU"u_2[HF5U3)?WY?5S#*>^kz#,nE_=zEpkW1H)x5-lCmg's\BWOI%WfUs^%(.=5T*πU"aqm.KFo&XnYWDcb=c2+[fV$kkS;aO_0e=3cE<h#iqP)n.8PlW#nI)CaS$cfOQwJπU"<nSaPVl&+n^#+JVx9iw#+Wn7p?70_e2u?[h1<v+[HT8KL7u$9ES3;rqb1pmhyZYπU"VljN8hSSa<r[W-?SU&vRU738a(2_Y*a_X&WD>]35eMd&Qgeam+<W\)*qGZGlD([πU"5&zUp()ymZxEW2;IL;Z1B[1(/m5f%i7n9G+dmA/?rc1<swqL4rR$N_r>ab]9<BYπU"'M(Wx0I>AB%Wnu4AFzto%ChVBbII0)_25pHu..m6?h--ZhA.oG>tcek._5NAY%UπU"gy25v6[Wm,&0q8<BfomRGnla15fUEw1.XFl8rp.ToebD+qICu,;kAEPi5I;Ybo[πU"0X*V3GebN2Ybz8'pyIQ5;p3hOlJ3rfE*qB_&?t:7H*p:Z5(YP8Q,f;TrC-*g&aYπU"p:5av6jcA+TchAX=kO#\,EYWnm+x?i'o>*tx)o/NZf+ptSKpJ4502nWY.=kWpl\πU"XL4#y_.hL*KYy.wZU&niKB5T7)s5chtkhZt+pL2q.Jze%\.aqiv*>[fApNeQFa<πU"R7cH_G+]L&qCp%&[D]'7Q<P^v_&>v$<8l0I<(#&UptIAd\qgpX;aGo1J$5oH=XjπU"Egf]Od].T-62.)%hK+0ZqFD_Th.%ki[\Q_iG]fXTjoRg/N6CyD<o5_6EPq\vj>gπU"7,[Ld=r5h]\td;.c9-wKQvSlC6yTXfP.;3O\4<mJ8P\vP$pz<5-R%G1o.>4rd,/πU"*1R$c&-=X:tkIA'w,<0cSOKDg[7koY][BXdYZWaIE5l0C)bDB-;:4vi)lEqHMVHπU"zrjYDQ5CFB+jeGc,3*h1xt]'d1[^S35\f)._<kqA*?qACFbZ__mO]=Bc2Z:>''KπU"5tHsMjP'_;#Ul/$AV&jSA:6f5Gu?:CFkC6Qg1NfmiPbp\VX89sY,*wq/ieu_rR?πU"+1P)tBScMwyXt]STXrg2F(4&pZrsUZPJuidqhckDXvm_xvkhki6<uZ8?0KAAZ6SπU"AQwQMKF7[pk[uXrs51o1Xj[aO0K>m&+]?oR,^]'KHPg0qv<M&/v6.nFXOXSJeE+πU"L5bh)4g[gpM^idg*Q[f_HY*+e%Kkyy#/LJX=qeP(>^DC>I^avWgr%(O0k9YB5M3πU"X%hL1ti7g*Z$Ippz'HG'P0]JsoZnNaa9]+pKvAQ\#BL_k9Q3C>T-&?*(/jY-79_πU"d$-bQP>:/r;4WljLaM^IXBUa_u&7uANp03KtF-0PA[<.5;E?0PLLmSid6,WXdYjπU"'%/t.BC(\PR0iVzWVDrz4N.;l?fp^':'\c9&4L-uu<Q;M*_MiotPlPM/6TCReM7πU"H$&=))i)rCr'&$g\p*eqEZe:Xkuq1dRww4mJ-'sH;0sk<XaIef+JnnF%T.?ZP),πU"q1btuIBoKWRFP#\E,Ve>l51u7^/hBoz0tbjXO?(iiXf_lx[>CpNa&>[/8.BBh)gπU"(LVk[l<?Px%Y<Ly3R#NIUPefY['<<$k7*Oyu0XD1s9Q*D9zV(kt_.f^Y-PjxDIaπU"6R833>TE-H)9Igm8o/RD-++i^8y/mu396mbdzQXZm]&+w-5CDWZ-&37;d>I\H97πU"b=Jz3Zo/)Z;advkyKJZI(+(s5=t.v4t\HB#>g7q8,-+'TTuHR:m$4IHuBum'PJ'πU"M_Tz.$pey6nX&P*v5q(szVrqT[b3-=I0,p.K3]DNmXv&lRGb;lLjVrRY;5/MS1oπU"vI^]GX&(hR/E0Z9bLrZ'd[v[=7fIC.,>6q%bA?eGDCXA*qSfA-aTnG7)-=b2ob5πU"Ltqa(6c51KT:[4q%U)1ZHUJn1Npenemc,U[\(e9j'K'3-NZ_K);sN0TM'lgbsTAπU"sQ2l?r'9F^^Ilt#,nIra/lHiRDi;-:_1i'\(#lJQXVsC9#.rJ?3F?.AWIfeWYETπU"+a^kHHF#)t-g7JT0a3qze#kT&NOKkt#2W#NPCraGFcKh;RA**&x<=0sFt%PAz\*πU"GAzvkS&T)YIk,3A#w20L>%e7ra=6*?*+.;Hk-Km)3o>652eP$LI?&#:nO3*WchcπU"$JwH.q%qiVz15RCVMP?SuMW.c3^*z^Ds#69Ojo^oX&6MAFOJXwV#?J,8W;c<uX=πU"BePeJH?>e:^..-7wKsXL^c^L1=[dGJ=6)u=DT>=qX\8GRqSfB0?Z-ufcp8b;T:CπU"D,_i7o*z7li4,X)*4,*]oc7aVo')m4b,gr49>s'HW3T[j$mq7n>61kN:OMZxEAZπU"N#X4q[jjGO_V=2+sVTbo_]dQM&-k]wlBjCjq=#BRoZJ*S)cCE>uF.>M4.$?Yf,_πU"[76N9Li6xf$G6mHEc;t/ATsZ#lWnUnyR%9Dt*Ww,XaNGJC#]D70gD]u_4i_Ox(<πU"GWl$F93Ur6*9QTkQSf%F4)MH5.D;v7McFu<H_Nt%DBsv/lDzv9#Ni/TDhYunKP4πU"uP[4k^&a$S^1mV_G5)0$^?;_P*z8W(2'PK22g6\/s(_P*Sig;68d\'a2U;3qI*#πU"d;?gX&Oj+;1Y/L([0#U,k<MORG;jQI)LZ3#b5?E+D/PjVUr>X1V.7:QI+d;Ih<LπU"3s<Z*)c_Z.9b5'XQ2R1Q+/J0(.bpaAQ8>e\R^NflG?+5iAv4A,uDGfD/K=[NUe[πU"e&#VR/9+]guoW>:hPsQAc/Y/*6oeh#;Y.TF3lvP5+_q'_HDS8OSDz8O1Vi,Spx0πU"M5'p#u8^i8CITAX0pR+3fO5L6GP7X__swROwY?-g?29WvFav&:hmCllHK(FpUO1πU"F%q]0AR9R6jA7^1?Lm(tJLFdtssc'C\aSg>z3)9Kl#F=dQZdh[A8';fCPknFMV,πU"KJBl-8b4o_P=,M&Wc6%c4sVDn:S?5k]IZeX%+++=?Q9I+pk\F2aGg,m&l86dGKsπU"mZ%T?bIimp\gj#m_J'2w7a+W'H(ueT9Ia+s[ImZeP?fbOYQo9x4W.:hV:uQBNU=πU"X2IB;S;G1RI9*X/teL[e:979(KX'2]RqW1Yq3%MG,\eV69'p3^*DS8OSDz:PCdEπU"HtDdv35^:ZG6J0B>jv^(M]I-km2D\p33j,[&EnDMyghP,5M.f4?^jDHs\DHG4S,πU";d\<YSn5pkEAabp7B+%1^(/BdHLw2^kocDAK$3%>q;HuA]nm<b0<'%B#_2;'7:GπU"+0O\UB0&#'o)F<'H^EFh>4a*BNOIdN^Lte+foe]$88.U#7==g$<(>:G%0;?=,cqπU"(0;n>:app*P9MUD[;:O\/)(XD1R9/1d[Pb/U>FuAY2WYIn'H27Ju+hOJ+0_?KiLπU"C/Ms-bnB(VR93zS2E(UK:JX6)/L0;7nq%z(FXXQUzkC=5^RoGUzTTB;MU_dmhugπU"h^-jQlT+7iV?]Pqhga*Yt)$PE*hwVER,LNj6/M_;D=c\#&VMKU2Y2ipu9qXh-PEπU"fUTG0DIhnu;J8Z\O]U743swpiWZt$#K208M7v.TeMO.>Ii8H5wANSQgh<fkMu1bπU"S5a4m6E'8b<Uuv1V\#-I]uk6=G=l,w/'9VSd?7yH,x]O?^:^:MS7MHX)f>sZZ#RπU"L&aQmhjUlU9>qCmuOo^ZviLZ+&ejz*fUMFgJjPfRpqCdi%5E%ziN_M-za/'aqQcπU"(+(__Pf(S,3^#wlqbQ%<(z<<$-QviMDd>sBM'p4PF3w+FD+Qf\mgJb]Zua_%#wGπU"Q/Z(F?MYhj<*7yWQitpZ+b9vkCRaex6lpQdHLqus48g;HSq4V)(>Ed\2cup/&RNπU"gR[$v:5rh^adulZOYwmMr4h[1JJI1Nmsi:?Tv9t7>CGiuu)4g/tl*WC^]AO*gcZπU"Z5S_^7>[fH)EQr7>4KMK+;tDR8Tj2x[xSt$YZ]3F02=NiBW#4Z1tv#a^LFD;O4WπU"_kRzj<zY#3e1nncE#R<pm:]5mLBmq-ic[KO+w%4up(%)/%%#%%%>&%(F%%%%%%%πU"%%%%%%%%>%%%%u%wtli.wf&T#iwf&%Tijk%fzqy%Sgfx%up&'%9%9%%%%%%8:0wπU"E%%%%%%%%%%%%%%%%3%%%%%%%%%&%U%%%%%%%%%uw%tliw(f&Ti.wf&T%up&'%9πU"%/%%%%%%)=%(F%%%%%%%%%%%%%%%%9%%%%%%%%%&%E%%%%Q%%%%uw%tliw(f&TiπU".wf&i%fySu(i&up%&'9%%/%%%I%%=%%(F%%%%%%%%%%%%%%%9%%%%%%%%%&%%E%πU"%%&-%%%%uwtl#iwf&%Tity#iwf&#Sui&%up&'%9%9%%%%-%9;wvE0987I%L%%%%πU"O%%%%:%%%%%%%%%&%E%.%%_%%%%uw%tliw(f&Tu%wtli.wf&S%gfyu%p&'9%%9%πU"%#%-%U#I&FE[r]9d%'%%N%*%%9%%%%%%%%%&%%E%%+%c%%%%uwt%liwf&&Tns%xπU"yfq#qSy'%yup&%'9%9%%%%-(%Uw&+F+E2&b9%%%%>%%%%6%%%%%%%%%&%E%%%%,πU"%)%%u%wtli.wf&T%zxjw%Snsn%up&'%9%9%%%%-%%OI&FOt)PU&^2%%%^\%%%7%πU"%%%%%%%%&%E%%%%o)%%%uw%tliw(f&TiIwf&&%Sgfx%up&'%9%/%%%%%%)>%(F%πU"%%%%%%%%%%%%%%%>%%%%%%%%%&%E%%%%.7%%%uw%tliw(f&Ti.wf&T%ijkf%zqyπU"S%gfxu%p*+%%%%%-%%-%0%'%%e%7%%%%%πEND SUBπCLOSE:IF S=255AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπTony Cave BURNING FIRE SIMULATOR FidoNet QUIK_BAS Echo 07-31-96 (01:12) QB, QBasic, PDS 218 7253 BURNING.BAS 'burning.bas is a fire simulator followed by a palette manipulatorπ'1 compile the program (Qbasic v1.1 users see REMarks in SUB getsizes)π' (you need to save this in QB to generate the DECLARE statements)π'2 run the program specifying window sizeπ' EXAMPLE: burning 100 80π' where 100 is the x value and 80 is the y valueπ' executing burning with no parameters uses the default values.π' (you might want to use the defaults first to get a feel for it)π' for great palette manipulations try using: burning 200 160π'3 when you want to freeze the screen and go into palette manipulations,π' press a keyπ'4 in the palette manipulations:π' press "P" for a different palette setπ' "-" to slow down palette rotationπ' "+" or "=" to speed up palette rotationπ' "Q" to quitπ'Feedback would be appreciated (especially on speeding up the fire sub)πDIM ca(9, 256)πID$ = "BURNING.BAS (c) 1996 by Tony Cave"πscreenmode ' setup the screenπgetsizes ' get the screen sizesπfirepal ' setup palette for fireπcircleback ' draw circular background (REM this out if you don't like it)πrandback ' draw random background to speed up fire simulationπfire ' fire simulationπcolors ' palette manipulationsπ'NOTE: This program is not guaranteed to do anything. The authorπ'of this program claims no responsibility for anything that happens.π'If any damage is done, it is the fault of the user of this program.πSUB circlebackπFOR cir = 0 TO 255 'add this sub for a circle backgroundπCIRCLE (160, 100), cir * 203 / 255, cir / 2πCIRCLE (160 + 1, 100), cir * 203 / 255, cir / 2πNEXTπEND SUBπSUB colorsπSHARED a$πDOπ DOπ cycleπ delayπ getkeyπ LOOP UNTIL a$ <> ""π keycheckπLOOPπEND SUBπSUB cycle 'cycle the paletteπSHARED red%, green%, blue%πrgb 1πu1% = red%: u2% = green%: u3% = blue%πFOR t = 1 TO 254π rgb t + 1π OUT &H3C8, t: OUT &H3C9, red%: OUT &H3C9, green%: OUT &H3C9, blue%πNEXTπ OUT &H3C8, 255: OUT &H3C9, u1%: OUT &H3C9, u2%: OUT &H3C9, u3%πEND SUBπSUB delayπSHARED m7πFOR asdf = 1 TO m7: NEXTπEND SUBπSUB findrgb (x%, y%) 'finds the rgb of a particular pixelπSHARED red%, green%, blue%πc% = POINT(x%, y%)πOUT &H3C7, c%πred% = INP(&H3C9)πgreen% = INP(&H3C9)πblue% = INP(&H3C9)πEND SUBπSUB fireπSHARED sizex, sizey, space, ca()πDIM x AS INTEGER, y AS INTEGER, avg AS INTEGERπDOπx = INT(RND * sizex) * space - INT(sizex / 2) * space + 160πy = INT(RND * sizey) * space - INT(sizey / 2) * space + 100πavg = POINT(x - space, y + space)πavg = (avg + POINT(x + space, y + space) + POINT(x, y + space)) \ 3πavg = avg * -(avg < 255)πPUT (x - 1, y - 1), ca(1, avg + 1), PSETπLOOP UNTIL INKEY$ <> ""πEND SUBπSUB firepal 'the starting paletteπFOR pu = 1 TO 255π OUT &H3C8, puπ OUT &H3C9, (126 - (ABS(pu - 128))) / 2π OUT &H3C9, (126 - (ABS(pu - 128))) / 4π OUT &H3C9, 0'((ABS(pu - 128))) / 4π'LINE (pu, 0)-(pu, 25), pu 'This is to check out the paletteπNEXT puπPALETTE 128, &H20303FπEND SUBπSUB getkeyπSHARED a$πa$ = INKEY$πEND SUBπSUB getsizes 'get the screen sizeπSHARED sizex, sizey, hsizex, hsizey, spaceπspace = 1 'distance apart for pixels or boxes or whateverπsizex = VAL(LEFT$(COMMAND$, 3))πsizey = VAL(RIGHT$(COMMAND$, 3))π'Qbasic users REM out the above 2 lines and unREM the below lineπ'sizex = 20: sizey = 20 'change these to what ever you want butπ 'larger numbers slow it down alotπ 'For good palette manipulations, change toπ 'sizex=316:sizey=196 and wait about 7 minπ 'before pressing a keyπa = sizex: B = sizey: c = 318: d = 198πsizex = a * ABS((a <> 0) AND (a < c)) + 50 * ABS(a = 0) + c * ABS(a > c)πsizey = B * ABS((B <> 0) AND (B < d)) + 30 * ABS(B = 0) + d * ABS(B > d)πhsizex = INT(sizex / 2)πhsizey = INT(sizey / 2)πEND SUBπSUB keycheckπSHARED a$, m7π IF a$ = "=" OR a$ = "+" THENπ m7 = m7 - 1000: m7 = m7 * -((m7 - 1000) > 999)π END IFπ IF a$ = "-" THEN m7 = m7 + 1000π IF UCASE$(a$) = "P" THEN nextpalπ IF UCASE$(a$) = "Q" THEN DEF SEG : SYSTEMπEND SUBπSUB nextpalπSHARED palnum, red%, green%, blue%πnop = 5 'number of valid palette sets in case you want to add moreπpalnum = palnum + 1πIF palnum > nop THEN palnum = 1πSELECT CASE palnumπCASE 1πPALETTEπCASE 2πt = 0: m = 0πFOR pu = 1 TO 255π IF t = 0 THEN count = count + 1: IF count > 31 THEN t = 1π IF t = 1 THEN count = count - 1: IF count < 1 THEN t = 0: m = m + 1π IF m > 3 THEN m = 0π OUT &H3C8, puπ OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 0) OR (m = 3))π OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 1) OR (m = 3))π OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 2) OR (m = 3))πNEXT puπPALETTE 255, 0πCASE 3πse = INT(.03 * 127): th = INT(.08 * 127): fo = INT(.99 * 127)πFOR pu = 1 TO seπ OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 32πNEXT puπFOR pu = se TO thπ OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0π OUT &H3C9, INT((pu - se) * (31 / (th - se))) + 32πNEXT puπFOR pu = th TO foπ OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0π OUT &H3C9, 63 - (INT((pu - th) * (31 / (fo - th))) + 32)πNEXT puπFOR pu = fo TO 127π OUT &H3C8, puπ OUT &H3C9, INT((pu - fo) * (63 / (127 - fo)))π OUT &H3C9, INT((pu - fo) * (63 / (127 - fo)))π OUT &H3C9, 63πNEXT puπFOR pu = 128 TO 255π rgb 255 - puπ OUT &H3C8, pu: OUT &H3C9, red%: OUT &H3C9, green%: OUT &H3C9, blue%πNEXT puπCASE 4πt = 0: m = 0πFOR pu = 1 TO 255π IF t = 0 THEN count = count + 1: IF count > 6 THEN t = 1π IF t = 1 THEN count = count - 1: IF count < 1 THEN t = 0: m = m + 1π IF m > 3 THEN m = 0π OUT &H3C8, puπ OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 0))' OR (m = 3))π OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 1))' OR (m = 3))π OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 2))' OR (m = 3))πNEXT puπPALETTE 255, 0πCASE 5πFOR pu = 1 TO 255π OUT &H3C8, puπ OUT &H3C9, (126 - (ABS(pu - 128))) / 2π OUT &H3C9, (126 - (ABS(pu - 128))) / 4π OUT &H3C9, 0'((ABS(pu - 128))) / 4π'LINE (pu, 0)-(pu, 25), puπNEXT puπPALETTE 128, &H20303FπEND SELECTπEND SUBπSUB randbackπDIM c AS INTEGERπSHARED sizex, sizeyπfy1 = ABS(sizey / 2 <> sizey \ 2): fy2 = NOT ABS(fy1)πfx1 = ABS(sizex / 2 <> sizex \ 2): fx2 = NOT ABS(fx1)πFOR y = 100 - sizey / 2 - 1 + fy1 TO 100 + sizey / 2 + 1 + fy2πFOR x = 160 - sizex / 2 - 1 + fx1 TO 160 + sizex / 2 + 1 + fy2πc = INT(RND * 50 + 206)π'use the following two lines for a special backgroundπ'c = (COS((y * .03515625# - 3.515625) ^ 2) * 63.75 + 63.75)π'c = c + (COS((x * .0265625 - 4.25) ^ 2) * 63.75 + 63.75)πPOKE INT(y) * 320 + INT(x), cπNEXTπNEXTπEND SUBπSUB rgb (gluupin%) 'finds the rgb of a color attributeπSHARED red%, green%, blue%πOUT &H3C7, gluupin%πred% = INP(&H3C9): green% = INP(&H3C9): blue% = INP(&H3C9)πEND SUBπSUB screenmodeπSHARED ca()πDEF SEG = &HA000πSCREEN 13πFOR x = 0 TO 765 STEP 3πx2 = x + 318 * (x > 315)πx3 = x2 + 318 * (x2 > 315)πy = (-(x > 315) - (x > 630)) * 3πLINE (x3, y)-(x3 + 2, y + 2), x / 3, BFπGET (x3, y)-(x3 + 2, y + 2), ca(1, x / 3) 'put colors into array toπNEXT 'speed up the fire subπEND subπKurt Kuzba BOUNCING GREAT BALLS OF FIRE FidoNet QUIK_BAS Echo 04-18-96 (00:00) QB, QBasic, PDS 77 3098 RGB13FLO.BAS'_|_|_| RGB13FLO.BASπ'_|_|_| A graphics display program based on a FIDO ECHO messageπ'_|_|_| From: Mike Castelli ... Date: 04-05-96 10:48π'_|_|_| Subject: Circle Burnπ'_|_|_| No guarantees or warrantees are given or implied.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (4/18/96)πCRSX% = CSRLIN: CRSY% = POS(0): ScrPocket 1πTYPE BallsColorDef: R AS INTEGER: G AS INTEGER: B AS INTEGER: END TYPEπTYPE GreatBallsOfFireπ X AS INTEGER: XD AS INTEGER: Y AS INTEGER: YD AS INTEGERπ H AS INTEGER: C AS INTEGER: END TYPEπDIM SHARED cr(1 TO 6) AS GreatBallsOfFireπDIM SHARED rgb(1 TO 6, 16) AS BallsColorDefπFOR t% = 0 TO 8π C% = t% * 5 + 22: B% = (t% + 1) * 2π rgb(1, t%).R = C%: rgb(1, t%).G = B%: rgb(1, t%).B = t%π rgb(2, t%).R = t%: rgb(2, t%).G = C%: rgb(2, t%).B = B%π rgb(3, t%).R = B%: rgb(3, t%).G = t%: rgb(3, t%).B = C%π rgb(4, t%).R = C%: rgb(4, t%).G = 0: rgb(4, t%).B = C%π rgb(5, t%).R = 0: rgb(5, t%).G = C%: rgb(5, t%).B = C%π rgb(6, t%).R = C%: rgb(6, t%).G = C%: rgb(6, t%).B = 0: NEXTπFOR t% = 1 TO 7π FOR C% = 1 TO 6: rgb(C%, 16 - t%) = rgb(C%, t%): NEXT: NEXTπSCREEN 13: RANDOMIZE (TIMER * 100): PalPocket 1πFOR t% = 1 TO 6π cr(t%).X = RND * 320: cr(t%).Y = RND * 200π cr(t%).XD = (RND * 2 + 1): cr(t%).YD = (RND * 2 + 1)π cr(t%).H = t% * 2: NEXTπWHILE INKEY$ = ""π CircDrawπ FOR t% = 1 TO 6π IF cr(t%).X < 10 THEN cr(t%).XD = ((RND * 999) AND 1) + 1π IF cr(t%).Y < 10 THEN cr(t%).YD = ((RND * 999) AND 1) + 1π IF cr(t%).X > 309 THEN cr(t%).XD = -(((RND * 999) AND 1) + 1)π IF cr(t%).Y > 189 THEN cr(t%).YD = -(((RND * 999) AND 1) + 1)π cr(t%).X = cr(t%).X + cr(t%).XDπ cr(t%).Y = cr(t%).Y + cr(t%).YD: NEXTπWEND: PalPocket 0: SCREEN 0: WIDTH 80, 25πLOCATE CRSX%, CRSY%, 1: ScrPocket 0πSUB CircDrawπ FOR C% = 1 TO 6π cr(C%).H = (cr(C%).H + 1) AND 15π cr(C%).C = (cr(C%).C + 14) AND 15π X% = cr(C%).X: Y% = cr(C%).Y: H% = cr(C%).Hπ FOR l% = 0 TO 11π CIRCLE (X%, Y%), l% + 1, ((H% + l%) AND 15) + C% * 16 - 15π NEXTπ FOR t% = 1 TO 16π OUT &H3C8, t% + (C% - 1) * 16: H% = (cr(C%).C + t%) AND 15π OUT &H3C9, rgb(C%, H%).R: OUT &H3C9, rgb(C%, H%).Gπ OUT &H3C9, rgb(C%, H%).B: NEXT: NEXTπEND SUBπSUB PalPocket (save%) STATICπ DIM pal(384) AS INTEGERπ DEF SEG = VARSEG(pal(0)): O& = VARPTR(pal(0))π IF save% <> 0 THENπ FOR t% = 0 TO 255π OUT &H3C7, t%: POKE O& + t% * 3 + 0, INP(&H3C9)π POKE O& + t% * 3 + 1, INP(&H3C9)π POKE O& + t% * 3 + 2, INP(&H3C9): NEXTπ ELSEπ FOR t% = 0 TO 255π OUT &H3C8, t%: OUT &H3C9, PEEK(O& + t% * 3 + 0)π OUT &H3C9, PEEK(O& + t% * 3 + 1)π OUT &H3C9, PEEK(O& + t% * 3 + 2): NEXTπ END IFπEND SUBπSUB ScrPocket (gt%) STATICπ DIM scr(4000) AS STRING * 1π DEF SEG = &HB800π IF gt% <> 0 THENπ FOR t& = 0 TO 3999: scr(t&) = CHR$(PEEK(t&) AND 255): NEXTπ ELSEπ FOR t& = 0 TO 3999: POKE t&, ASC(scr(t&)): NEXTπ END IFπEND SUBπ'_|_|_| end RGB13FLO.BASπKurt Kuzba BUFFERED PCX VIEWER FidoNet QUIK_BAS Echo 07-20-96 (00:00) QB, QBasic, PDS 66 2566 PCXVIEW.BAS '> ok, well the basic gif displayer I have is very slow, aboutπ'> 3-4 min. to display a picture. Is there a faster way toπ'> display pixels?π'>..............................................................π' You might benefit from the use of a buffer. Have a look atπ'this. It is for 320x200x256 .PCX files, but the idea of theπ'screen buffer is implemented. Where a greater ammount ofπ'calculation is required, and multiple bit planes are involved,π'the time savings should be considerable using a buffer.π'With four bit planes, you would use four buffers set up as:π' DIM buf0(19202) AS INTEGERπ' DIM buf1(19202) AS INTEGERπ' DIM buf2(19202) AS INTEGERπ' DIM buf3(19202) AS INTEGERπ'Once you GET your screen to your buffer, you can write to theπ'buffer your data, and then PUT the data onscreen.ππ'_|_|_| PCXVIEW.BASπ'_|_|_| An example of 320x200x256 .PCX display in QBasic.π'_|_|_| No warrantees or guarantees are given or implied.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (7/20/96)πON ERROR GOTO OOps: '$DYNAMICπDIM buf(32002) AS INTEGER: buf(0) = 2560: buf(1) = 200π'_|_|_| init buffer for 2560 bits X 200 linesπBSEG& = VARSEG(buf(2)): BOFS& = VARPTR(buf(2))πINPUT "Name of PCX file to view => ", PCX$: IF PCX$ = "" THEN ENDπbt1! = TIMER: PRINT "Loading file"πOPEN PCX$ FOR INPUT AS #1: CLOSE 1: OPEN PCX$ FOR BINARY AS #1πfin& = LOF(1) - 767: SEEK #1, fin&: pal$ = INPUT$(768, 1)πp% = 1: fin& = fin& - 1: SCREEN 13πFOR T& = 0 TO 255π OUT &H3C8, T&π FOR hue% = 1 TO 3π OUT &H3C9, ASC(MID$(pal$, p%)) \ 4: p% = p% + 1π NEXTπNEXTπSEEK #1, 129: T& = BOFS&: DEF SEG = BSEG&: CLS : spin% = 1πPRINT "Loading PCX "; : spinner$ = "//--\\||": rle% = 0πDOπ PRINT CHR$(29); MID$(spinner$, spin%, 1);π spin% = (spin% AND 7) + 1π p$ = INPUT$(256, 1): fpos& = SEEK(1): l% = LEN(p$)π IF fpos& > fin& THENπ l% = l% - (fpos& - fin&): p$ = LEFT$(p$, l%): view$ = "done"π END IFπ FOR p% = 1 TO l%π dat% = ASC(MID$(p$, p%))π IF rle% = 0 THENπ IF (dat% AND 192) = 192 THENπ rle% = dat% AND 63π ELSEπ POKE T&, dat%: T& = T& + 1π END IFπ ELSEπ FOR rle% = rle% TO 1 STEP -1π POKE T&, dat%: T& = T& + 1π NEXTπ END IFπ NEXTπLOOP UNTIL view$ = "done"πbt2! = TIMER: CLOSE 1: PUT (0, 0), buf, PSETπWHILE INKEY$ <> "": WEND: WHILE INKEY$ = "": WENDπSCREEN 12: WIDTH 80, 25: PRINT bt2! - bt1!πOOps:π CLOSE 1: PRINT "error"; ERR: ENDπ'_|_|_| end PCXVIEW.BASπDarryl Stokes DONUT BALLS FidoNet QUIK_BAS Echo 07-22-96 (16:33) QB, QBasic, PDS 59 1169 DONUTS.BAS RANDOMIZE TIMERπSCREEN 13ππrecalc:π'CLSππred = 0πgreen = 0πblue = 0ππredbig = INT(RND * 5) + 1πgreenbig = INT(RND * 5) + 1πbluebig = INT(RND * 5) + 1πIF redbig = 2 THEN redbig = .5πIF greenbig = 2 THEN greenbig = .5πIF bluebig = 2 THEN bluebig = .5πIF redbig = 3 THEN redbig = .25πIF greenbig = 3 THEN greenbig = .25πIF bluebig = 3 THEN bluebig = .25πIF redbig = 4 THEN redbig = .75πIF greenbig = 4 THEN greenbig = .75πIF bluebig = 4 THEN bluebig = .75πIF redbig = 5 THEN redbig = 0: red = 1πIF greenbig = 5 THEN greenbig = 0: green = 1πIF bluebig = 5 THEN bluebig = 0: blue = 1ππFOR i = 30 TO 92π red = red + redbigπ blue = blue + bluebigπ green = green + greenbigπ PALETTE i, 65536 * INT(blue) + 256 * INT(green) + INT(red)πNEXT iππc = 32πdir = 1ππcircles:πDOπx = INT(RND * 320) + 1πy = INT(RND * 200) + 1πr = INT(RND * 150) + 1πFOR i = r TO 1 STEP -1πCIRCLE (x, y), i, cπPAINT (x, y), cπSELECT CASE dirπ CASE 1π c = c + 1π IF c = 92 THEN dir = 2π CASE 2π c = c - 1π IF c = 32 THEN dir = 1πEND SELECTπNEXT iπc = 32πdir = 1πIF INKEY$ <> "" THEN ENDπGOTO recalcπLOOPππKurt Kuzba PALETTE MANIPULATION FidoNet QUIK_BAS Echo 06-02-96 (00:00) QB, QBasic, PDS 86 4033 PALPAL.BAS '> 'I like this one alot. It uses the PALETTE statementπ'>.......................................................π' The yin-yang was very nice. Here are some hardware paletteπ'routines you might someday find useful.π'_|_|_| PALPAL.BASπ'_|_|_| This is a simple demonstration of methods of paletteπ'_|_|_| manipulation. Demonstration uses graphics mode 13h.π'_|_|_| No warrantees or guarantees are given or implied.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (6/2/96)πDECLARE SUB pal (act$)πSCREEN 13: DEF SEG = &HA000: DIM SHARED red(256) AS INTEGERπDIM SHARED grn(256) AS INTEGER: DIM SHARED blu(256) AS INTEGERπFOR t& = 1 TO 63999: POKE t&, (t& AND 511) \ 2: NEXTπSOUND 999, 3: pal "save"πpal "fadeout": SOUND 999, 3: WHILE INKEY$ = "": WENDπpal "fadein": SOUND 999, 3: WHILE INKEY$ = "": WENDπpal "blackout": SOUND 999, 3: WHILE INKEY$ = "": WENDπpal "restore": SOUND 999, 3: WHILE INKEY$ = "": WENDπSCREEN 0: WIDTH 80, 25: ENDπSUB pal (act$)π SELECT CASE act$π ' "save","fadein","fadeout","restore","blackout"π CASE "save"π FOR colour% = 0 TO 255π OUT &H3C7, colour% ' Set color to readπ red(colour%) = INP(&H3C9) ' read red valueπ grn(colour%) = INP(&H3C9) ' read green valueπ blu(colour%) = INP(&H3C9) ' read blue valueπ NEXTπ CASE "fadein"π DOπ done% = 0π FOR colour% = 0 TO 255π OUT &H3C7, colour% ' Set color to readπ red% = INP(&H3C9) ' read red valueπ grn% = INP(&H3C9) ' read green valueπ blu% = INP(&H3C9) ' read blue valueπ ' Test the color values, decrementing if necessary.π ' Set loop variable if saved palette not in use.π IF red% < red(colour%) THEN red% = red% + 1: done% = 1π IF grn% < grn(colour%) THEN grn% = grn% + 1: done% = 1π IF blu% < blu(colour%) THEN blu% = blu% + 1: done% = 1π WAIT &H3DA, 8, 8π OUT &H3C8, colour% ' Set color to writeπ OUT &H3C9, red% ' write red valueπ OUT &H3C9, grn% ' write green valueπ OUT &H3C9, blu% ' write blue valueπ NEXTπ LOOP WHILE done% <> 0π CASE "fadeout"π DOπ visible% = 0π FOR colour% = 0 TO 255π OUT &H3C7, colour% ' Set color to readπ red% = INP(&H3C9) ' read red valueπ grn% = INP(&H3C9) ' read green valueπ blu% = INP(&H3C9) ' read blue valueπ ' Test the color values, decrementing if necessary.π ' Set loop variable if colors are still visible.π IF red% > 0 THEN red% = red% - 1: visible% = 1π IF grn% > 0 THEN grn% = grn% - 1: visible% = 1π IF blu% > 0 THEN blu% = blu% - 1: visible% = 1π WAIT &H3DA, 8, 8π OUT &H3C8, colour% ' Set color to writeπ OUT &H3C9, red% ' write red valueπ OUT &H3C9, grn% ' write green valueπ OUT &H3C9, blu% ' write blue valueπ NEXTπ LOOP WHILE visible% <> 0π CASE "restore"π FOR colour% = 0 TO 255π OUT &H3C8, colour% ' Set color to writeπ OUT &H3C9, red(colour%) ' write red valueπ OUT &H3C9, grn(colour%) ' write green valueπ OUT &H3C9, blu(colour%) ' write blue valueπ NEXTπ CASE "blackout"π FOR colour% = 0 TO 255π OUT &H3C8, colour% ' Set color to writeπ OUT &H3C9, 0 ' write red valueπ OUT &H3C9, 0 ' write green valueπ OUT &H3C9, 0 ' write blue valueπ NEXTπ END SELECTπEND SUBπ'_|_|_| end PALPAL.BASπPeter Cooper RAY CASTER 3D ENGINE peco@trenham.demon.co.uk 08-09-96 (10:31) QB, QBasic, PDS 93 2705 RAYCAST.BAS ' ==========================================================================π' RAY CASTER 3D sorta ENGINE thingymajigπ' ==========================================================================π' Wrote this about a month ago, it's a sort of wolfenstien\doom lookalikeπ' but all in native QBasic source! Uses an interesting ray tracing techniqueπ' could be optimized x1000 Infact, it's being converted to ASM and stuffπ' like textures will be added and maybe a bit of shadingπ'π' Anyway, this code is _public domain_, change it, modify it, whatever, itπ' only took about 40 mins in total, So whatever.. you have fun with it <grin>π'π' Cheers, {:o) Peter CooperππDECLARE SUB screensetup ()πDECLARE SUB makeworld ()πDECLARE SUB maketables ()πDIM SHARED st%(0 TO 360)πDIM SHARED ct%(0 TO 360)πDIM SHARED a$(1 TO 10)πpx% = 15: py% = 15: sa% = 0πPRINT "please wait..";πmakeworldπmaketablesπscreensetupπlp1:πFOR t% = sa% TO sa% + 59 STEP 1πxb = st%(t% MOD 360) / 100 'get incπyb = ct%(t% MOD 360) / 100 'get incπbx = px% 'decimal copyπby = py% 'decimal copyπl% = 0 'reset lengthπDOπbx = bx + xbπby = by + ybπl% = l% + 1πk% = ASC(MID$(a$(CINT(by / 10)), CINT(bx / 10), 1)) - 48πLOOP UNTIL k% <> 0ππ'PRINT l% this would print the distance to wall from playerπx% = (t% - sa%) * 5πdd% = (1000 / l%)πLINE (x%, 1)-(x% + 5, 99 - dd%), 15, BFπLINE (x%, 101 + dd%)-(x% + 5, 200), 2, BFπLINE (x%, 100 - dd%)-(x% + 5, 100 + dd%), k%, BFπLINE (x%, 100 - dd%)-(x% + 5, 100 - dd%), 0πLINE (x%, 100 + dd%)-(x% + 5, 100 + dd%), 0ππNEXT t%πPCOPY 0, 1ππin$ = INPUT$(1)πIF in$ = "x" THEN sa% = sa% + 3πIF in$ = "z" THEN sa% = (sa% + 357) MOD 360πIF in$ = CHR$(27) THEN SCREEN 0: WIDTH 80, 25: SYSTEMπIF in$ = " " THENπ px% = px% + (st%(t% MOD 360) / 50)π py% = py% + (ct%(t% MOD 360) / 50)πEND IFπGOTO lp1:ππSUB maketablesπ' Peters boring _yawn_ table creationπFOR tmp1% = 0 TO 360πst%(tmp1%) = SIN(tmp1% * .0174) * 100πIF tmp1% MOD 100 = 0 THEN PRINT ; ".";πNEXT tmp1%πFOR tmp1% = 0 TO 360πct%(tmp1%) = COS(tmp1% * .0174) * 100πIF tmp1% MOD 100 = 0 THEN PRINT ; ".";πNEXT tmp1%πEND SUBππSUB makeworldπ' Peter Coopers demonstration level. Change it if you wish! Each numberπ'isπ' a color numberπa$(1) = "1919191919"πa$(2) = "9000000001"πa$(3) = "1000000409"πa$(4) = "9010005001"πa$(5) = "1020040009"πa$(6) = "9030000001"πa$(7) = "1000078009"πa$(8) = "9050087001"πa$(9) = "1060000009"πa$(10) = "9191919191"πEND SUBππSUB screensetupπSCREEN 8, , 0, 1πCLSπWINDOW SCREEN (1, 1)-(320, 200)πEND SUBπJonathan Leger LED SCREEN SAVER leger@mail.dtx.net 08-12-96 (21:02) QB, QBasic, PDS 274 8803 LED.BAS DEFINT A-Zππ'LedDisplay() routine Original Author: Scott Pessoni - August 1995π'---> Modified by Jonathan Leger <---ππ'All other code, including InitLedDisplay() and InitLedBar(), writtenπ'by Jonathan Leger (leger@mail.dtx.net).ππDECLARE SUB InitLedDisplay (x%, y%, onc%, offc%, digits%, v%, a%)πDECLARE SUB InitLedBar (x%, y%, onc%, offc%, elems%, maxval%, v%, a%)πDECLARE SUB LedBar (Number#)πDECLARE SUB LedDisplay (Number#)ππDIM SHARED DisplayLedX, DisplayLedY, LedDigits, OnColor, OffColor, apage, vpageπDIM SHARED GraphLedX, GraphLedY, GraphElements, GraphNumππ'This string, scrollmsg$, _must_ have a space at the end.πscrollmsg$ = "REAL PROGRAMERS USE BASIC... ": scrollclr = 14ππSCREEN 7ππt# = TIMERπx# = 0πDOπ x# = x# + 1πLOOP UNTIL TIMER - t# > 1ππx# = x# / 5ππRANDOMIZE TIMERπcx = INT(RND * 280): cy = INT(RND * 160) + 12πxd = INT(RND * 2) + 1πIF xd = 1 THENπ xdir = -1πELSEπ xdir = 1πEND IFπyd = INT(RND * 2) + 1πIF yd = 1 THENπ ydir = -1πELSEπ ydir = 1πEND IFππdigits = 1: fore = 9: back = 8πsloc = 40: slet = 1: stog = 0ππDOππFOR Count# = VAL(STRING$(digits - 1, "9")) TO VAL(STRING$(digits, "9"))ππ x2# = 0π DOπ x2# = x2# + 1π LOOP UNTIL x2# >= x#ππ stog = stog + 1π IF stog = 5 THENπ stog = 0π SCREEN , , apage, vpageπ LOCATE 1, 1: PRINT STRING$(40, " ");π IF fore = 15 THENπ COLOR 9π ELSEπ COLOR fore + 1π END IFπ LOCATE 1, slocπ PRINT MID$(scrollmsg$, slet, (40 - sloc));π sloc = sloc - 1π IF sloc = 0 THENπ sloc = 1π slet = slet + 1π FOR sc = 2 TO 25π IF slet - sc < 1 THEN EXIT FORπ LOCATE sc, 1: PRINT MID$(scrollmsg$, slet - sc, 1);π NEXT scπ IF sc = 26 AND slet - sc = LEN(scrollmsg$) THENπ slet = 1: sloc = 40π END IFπ END IFπ END IFππ InitLedDisplay cx, cy, 0, 0, digits, 0, 1π LedDisplay -1ππ cx = cx - xdirπ cy = cy - ydirππ IF cx < 12 THENπ xdir = xdir * -1π cx = 12π ELSEIF cy < 12 THENπ ydir = ydir * -1π cy = 12π ELSEIF cx > 280 THENπ xdir = xdir * -1π cx = 280π ELSEIF cy > 180 THENπ ydir = ydir * -1π cy = 180π END IFππ InitLedDisplay cx, cy, fore, back, digits, 0, 1ππ LedDisplay Count#ππ key$ = INKEY$ππ SELECT CASE key$π CASE CHR$(27)π EXIT DOπ END SELECTππ IF (Count# MOD 100) = 0 THENπ fore = fore + 1π IF fore > 15 THEN fore = 9π END IFππNEXT Count#ππdigits = digits + 1ππLOOPππSUB InitLedBar (x%, y%, onc%, offc%, elems%, maxval%, v%, a%)ππapage% = a%: vpage% = v%πSCREEN , , apage%, vpage%ππGraphLedX = x% '|- Upper Left corner ofπGraphLedY = y% '| Led Graph displayπGraphElements = elems% 'Number of graph elements. Maximum 32πGraphNum = maxval% 'The number when the graph is 100%ππEND SUBππSUB InitLedDisplay (x, y, onc, offc, digits, v, a)ππapage = a: vpage = vππSCREEN , , apage, vpageππDisplayLedX = x '|- Upper Left corner ofπDisplayLedY = y '| Led Digit displayπLedDigits = digits 'Number of digits to have on displayππOnColor = onc: OffColor = offcππLedDisplay -1ππEND SUBππ'LedBar: A simulated Led Bargraphπ'-----------------------------------------------π'LedBar Numberπ' Number = The current number you want to update the bar graph withπ'-----------------------------------------------πSUB LedBar (Number#)ππIF Number# < 0 THEN 'If Negitive then blank Bar Graphπ FOR MakeGraph = 1 TO GraphElements * 2 STEP 2 'Make the Bar graphπ LINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), OffColor%π NEXT MakeGraphπ EXIT SUBπEND IFππElements = INT(Number# * GraphElements / GraphNum) 'Calculate Number ElementsπIF Elements > GraphElements THEN Elements = GraphElements 'Check limtsππ'----------------- Draw Bar Graph --------------------------------πFOR MakeGraph = 1 TO Elements * 2 STEP 2 'Make the Bar graph (Lit)πLINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), OnColor%πNEXT MakeGraphπFOR MakeGraph = Elements * 2 + 1 TO GraphElements * 2 STEP 2 'Make the Bar graph (DimπLINE (GraphLedX + MakeGraph, GraphLedY)-(GraphLedX + MakeGraph, GraphLedY + 5), OffColor%πNEXT MakeGraphπ'------------------------------------------------------------------πEND SUBππ'LedDisplay: Generates a simulated Digital Led Display.π'------------------------------------------------------------π'LedDisplay (Number)π' Number = The number you want to display on the Digital Displayπ'------------------------------------------------------------πSUB LedDisplay (Number#)ππSCREEN , , apage, vpageππIF Number# < 0 THEN 'Setup Led Display panelπ FOR PlotX = DisplayLedX TO DisplayLedX + ((LedDigits - 1) * 8) STEP 8π '----------- One LED Matrix digit --------------------π LINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), OffColor%π LINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), OffColor%π LINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), OffColor%π LINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), OffColor%π LINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), OffColor%π LINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), OffColor%π LINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), OffColor%π '------------------------------------------------------π NEXT PlotXπ EXIT SUBπEND IFππNumber# = FIX(Number#) 'Get rid of the decimals incase there are someπNumber# = VAL(LEFT$(STR$(Number#), LedDigits + 1)) 'Chop Number to LED sizeππPlotX = DisplayLedXππIF LEN(STR$(Number#)) - 1 < LedDigits THEN 'Clear Unused digitsπ FOR ClearEmptyDigits = 1 TO LedDigits - (LEN(STR$(Number#)) - 1)π LINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), OffColor%π LINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), OffColor%π LINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), OffColor%π LINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), OffColor%π LINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), OffColor%π LINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), OffColor%π LINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), OffColor%π PlotX = PlotX + 8π NEXT ClearEmptyDigitsπEND IFπππFOR PlotDigit = 1 TO LEN(STR$(Number#)) - 1 'Plot each number to a LEDππWorkDigit$ = MID$(STR$(Number#), PlotDigit + 1, 1) 'Get 1 DigitππSELECT CASE WorkDigit$ 'Find and select which elements to turn onπ CASE "0"π E1 = OnColor%: E2 = OnColor%: E3 = OnColor%: E4 = OffColor%: E5 = OnColor%: E6 = OnColor%: E7 = OnColor%π π CASE "1"π E1 = OffColor%: E2 = OffColor%: E3 = OnColor%: E4 = OffColor%: E5 = OffColor%: E6 = OffColor%: E7 = OnColor%π π CASE "2"π E1 = OffColor%: E2 = OnColor%: E3 = OnColor%: E4 = OnColor%: E5 = OnColor%: E6 = OnColor%: E7 = OffColor%π π CASE "3"π E1 = OffColor%: E2 = OnColor%: E3 = OnColor%: E4 = OnColor%: E5 = OffColor%: E6 = OnColor%: E7 = OnColor%π π CASE "4"π E1 = OnColor%: E2 = OffColor%: E3 = OnColor%: E4 = OnColor%: E5 = OffColor%: E6 = OffColor%: E7 = OnColor%π π CASE "5"π E1 = OnColor%: E2 = OnColor%: E3 = OffColor%: E4 = OnColor%: E5 = OffColor%: E6 = OnColor%: E7 = OnColor%π π CASE "6"π E1 = OnColor%: E2 = OffColor%: E3 = OffColor%: E4 = OnColor%: E5 = OnColor%: E6 = OnColor%: E7 = OnColor%π π CASE "7"π E1 = OffColor%: E2 = OnColor%: E3 = OnColor%: E4 = OffColor%: E5 = OffColor%: E6 = OffColor%: E7 = OnColor%π π CASE "8"π E1 = OnColor%: E2 = OnColor%: E3 = OnColor%: E4 = OnColor%: E5 = OnColor%: E6 = OnColor%: E7 = OnColor%π π CASE "9"π E1 = OnColor%: E2 = OnColor%: E3 = OnColor%: E4 = OnColor%: E5 = OffColor%: E6 = OffColor%: E7 = OnColor%πEND SELECTπ'Plot the LEDs to the screen------------------------πLINE (PlotX, DisplayLedY + 1)-(PlotX, DisplayLedY + 5), E1πLINE (PlotX + 1, DisplayLedY)-(PlotX + 5, DisplayLedY), E2πLINE (PlotX + 6, DisplayLedY + 1)-(PlotX + 6, DisplayLedY + 5), E3πLINE (PlotX + 1, DisplayLedY + 6)-(PlotX + 5, DisplayLedY + 6), E4πLINE (PlotX, DisplayLedY + 7)-(PlotX, DisplayLedY + 11), E5πLINE (PlotX + 1, DisplayLedY + 12)-(PlotX + 5, DisplayLedY + 12), E6πLINE (PlotX + 6, DisplayLedY + 7)-(PlotX + 6, DisplayLedY + 11), E7π'--------------------------------------------------πPlotX = PlotX + 8πNEXT PlotDigitππPCOPY apage, vpageππSCREEN , , vpage, vpageππEND SUBπClaude Gagné ICON MAKER V1.0 cgagne@globalserve.on.ca 08-16-96 (09:25) QB, QBasic, PDS 486 11658 ICONMAKE.BAS'****************************************************************************π'* [ Icon maker Version 1.0 ] *π'* [ Claude Gagné, Toronto, 1996 ] *π'* [ You can Email me at: cgagne@globalserve.on.ca ] *π'* *π'* [ You can modify this program but please, give me some credits !] *π'* *π'* [ This program make 50 X 50 pixels icons ] *π'* [ You can load those icon by using BLOAD command ] *π'* *π'* The mouse routines have been taken from *π'* Le Grand livre du QBASIC *π'* (c) Micro Application *π'* 1992 *π'****************************************************************************ππDECLARE SUB fenetre (xup%, yup%, xdown%, ydown%, aspect%, couleur%)πDEFINT A-ZππDECLARE SUB initsouris ()πDECLARE SUB souris (OnOff%)πDECLARE SUB FormeSouris (SoftHard%, BMasque%, CMasque%)πDECLARE SUB SetSouris (X%, Y%)πDECLARE SUB TempoSouris (Tempo%)πDECLARE SUB zonexsouris (X1%, x2%)πDECLARE SUB zoneysouris (Y1%, Y2%)πDECLARE SUB getsouris (Mode%)πDECLARE SUB attendrelachebouton ()πDECLARE SUB attenddeplacement (Mode%)πππDECLARE SUB ReadData ()πDECLARE FUNCTION Interr% (Num%, ax%, bx%, cx%, dx%)ππDECLARE SUB ABSOLUTE (Fonction%, par1%, par2%, par3%, adr%)ππππ'********** définir les variables globales **********ππDIM SHARED sourisx%, sourisy%, sourisk% '*** position et bouton de la sourisππDIM SHARED PM%(45) '** tableau pour le programme machineπReadData '** lire le programme machineππππππSCREEN 12πinitsourisπCLSππON ERROR GOTO gestionππDIM tampon(1 TO 1432)ππCALL fenetre(0, 0, 639, 479, 1, 7)πCALL fenetre(10, 10, 270, 270, 0, 0)πCALL fenetre(280, 10, 340, 70, 0, 0)ππCALL fenetre(286, 16, 335, 65, 1, 7)πGOSUB miseajourππCALL fenetre(280, 235, 629, 270, 0, 0) ' FENETRE COULEURππFOR c = 1 TO 16πLINE (c * 20 + 280, 240)-(c * 20 + 300, 265), c - 1, BFπNEXT cππCALL fenetre(280, 80, 340, 140, 0, couleur1) ' fenetre couleur1πCALL fenetre(280, 150, 340, 210, 0, couleur2) ' fenetre couleur2ππCALL fenetre(350, 10, 629, 225, 0, 0) ' FENETRE FONCTIONSππCALL fenetre(10, 280, 629, 469, 0, 0) ' FENETRE TEXTEππLOCATE 2, 46: COLOR 14: PRINT "Functions List"πCOLOR 15πLOCATE 3, 46: PRINT "F1 - New Icon"πLOCATE 4, 46: PRINT "F2 - Save"πLOCATE 5, 46: PRINT "F3 - Load"πCOLOR 7πLOCATE 6, 46: PRINT "F4 - Not Avail."πCOLOR 15πLOCATE 7, 46: PRINT "F5 - Shadow (Up)"πLOCATE 8, 46: PRINT "F6 - Shadow (Down)"πLOCATE 9, 46: PRINT "F7 - Shadow (Left)"πLOCATE 10, 46: PRINT "F8 - Shadow (right)"πLOCATE 11, 46: PRINT "F9 - Erase/Fill"πCOLOR 7πLOCATE 12, 46: PRINT "F10 - Not avail."πCOLOR 15πLOCATE 13, 46: PRINT "ESC => exit"πππsouris 1πDOπgetsouris 0πclavier$ = UCASE$(INKEY$)ππIF clavier$ = CHR$(0) + CHR$(59) THENππCALL fenetre(286, 16, 335, 65, 1, couleur1)πGOSUB miseajourπEND IFπππIF clavier$ = CHR$(0) + CHR$(60) THEN GOSUB sauvegardeπIF clavier$ = CHR$(0) + CHR$(61) THEN GOSUB chargementπIF clavier$ = CHR$(0) + CHR$(62) THEN GOSUB changercouleurπIF clavier$ = CHR$(0) + CHR$(63) THEN GOSUB ombrerhautπIF clavier$ = CHR$(0) + CHR$(64) THEN GOSUB ombrerbasπIF clavier$ = CHR$(0) + CHR$(65) THEN GOSUB ombrergaucheπIF clavier$ = CHR$(0) + CHR$(66) THEN GOSUB ombrerdroiteπIF clavier$ = CHR$(0) + CHR$(67) THEN GOSUB remplissageπIF sourisk% = 1 THENπIF sourisx% > 285 AND sourisy% > 235 AND sourisx% < 624 AND sourisy% < 265 THENπsouris 0πcouleur1 = POINT(sourisx%, sourisy%)πCALL fenetre(280, 80, 340, 140, 0, couleur1)πsouris 1πEND IFππIF sourisy% AND sourisx% > 285 AND sourisy% > 235 AND sourisx% < 624 AND sourisy% < 265 THENπsouris 0πcouleur2 = POINT(sourisx%, sourisy%)πCALL fenetre(280, 150, 340, 210, 0, couleur2)πsouris 1πEND IFππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF sourisx% > X * 5 + 10 AND sourisy% > Y * 5 + 10 AND sourisx% < X * 5 + 15 AND sourisy% < Y * 5 + 15 THENπsouris 0πLINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), couleur1, BFπPSET (285 + X, 15 + Y), couleur1πsouris 1πEXIT FORπEXIT FORπEND IFππIF sourisy% AND sourisx% > X * 5 + 10 AND sourisy% > Y * 5 + 10 AND sourisx% < X * 5 + 15 AND sourisy% < Y * 5 + 15 THENπsouris 0πLINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), couleur2, BFπPSET (285 + X, 15 + Y), couleur2πsouris 1πEXIT FORπEXIT FORπEND IFππNEXT YπNEXT XπEND IFπLOOP WHILE clavier$ <> CHR$(27)πsouris 0πCLSπENDππmiseajour:πsouris 0πFOR X = 1 TO 50πFOR Y = 1 TO 50πLINE (X * 5 + 11, Y * 5 + 11)-(X * 5 + 14, Y * 5 + 14), POINT(285 + X, 15 + Y), BFπNEXT YπNEXT Xπsouris 1πRETURNππombrerhaut:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 AND POINT(285 + X, 14 + Y) <> couleur1 THENπPSET (285 + X, 14 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππombrerbas:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 AND POINT(285 + X, Y + 16) <> couleur1 THENπPSET (285 + X, 16 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππombrergauche:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 AND POINT(284 + X, 15 + Y) <> couleur1 THENπPSET (284 + X, 15 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππombrerdroite:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 AND POINT(286 + X, 15 + Y) <> couleur1 THENπPSET (286 + X, 15 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππchangercouleur:πsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππIF POINT(285 + X, 15 + Y) = couleur1 THENπPSET (285 + X, 15 + Y), couleur2πEND IFππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππsauvegarde:πsouris 0πLOCATE 20, 5: PRINT STRING$(65, 255);πLOCATE 20, 5: LINE INPUT "Sauvegarde [.ICO]: "; fichier$πIF LEN(fichier$) = 0 THEN GOTO finsauvegardeππGET (286, 16)-(335, 65), tamponππDEF SEG = VARSEG(tampon(1))πBSAVE fichier$ + ".ICO", VARPTR(tampon(1)), 1432πDEF SEGπBEEPππfinsauvegarde:πLOCATE 20, 5: PRINT STRING$(65, 255);πsouris 1πRETURNππchargement:πsouris 0πLOCATE 20, 5: PRINT STRING$(65, 255);πLOCATE 20, 5: LINE INPUT "Chargement [.ICO]: "; fichier$πIF LEN(fichier$) = 0 THEN GOTO finchargementππDEF SEG = VARSEG(tampon(1))πBLOAD fichier$ + ".ICO", VARPTR(tampon(1))πDEF SEGππPUT (286, 16), tampon, PSETππGOSUB miseajourππBEEPππfinchargement:πLOCATE 20, 5: PRINT STRING$(65, 255);πsouris 1πRETURNπππremplissage:ππsouris 0ππFOR X = 1 TO 50πFOR Y = 1 TO 50ππPSET (285 + X, 15 + Y), couleur1ππNEXT YπNEXT XππGOSUB miseajourπsouris 1πRETURNππgestion:πBEEPπBEEPπRESUME NEXTπππMS.Data: '***** DATA du programme machine pour Interr%()π DATA 55,8b,ec,56,57 'sauver le registreπ DATA 8b,76,0c,8b,04 'chercher AX à DXπ DATA 8b,76,0a,8b,1cπ DATA 8b,76,08,8b,0cπ DATA 8b,76,06,8b,14π DATA cd,21 'INT 21 (numéro modifié !)π DATA 8b,76,0c,89,04 'réécrire AX à DXπ DATA 8b,76,0a,89,1cπ DATA 8b,76,08,89,0cπ DATA 8b,76,06,89,14π DATA 5f,5e,5d 'chercher le registreπ DATA ca,08,00 'RETF 8 => finπ DATA #πππSUB attenddeplacement (Mode%)π'** Attendre le déplacement de la souris ou l'appui/relâchement du boutonππ getsouris Mode%π X% = sourisx%: Y% = sourisy%: K% = sourisk%ππ DOπ getsouris Mode%π LOOP UNTIL X% <> sourisx% OR Y% <> sourisy% OR K% <> sourisk%ππEND SUBππSUB attendrelacheboutonπ'** Attendre le relâchement du bouton de la sourisππ WHILE sourisk%π getsouris 0π WENDππEND SUBππSUB fenetre (xup, yup, xdown, ydown, aspect, couleur)πππIF aspect <= 0 THENπ surface = 8π ombre = 15π lumiere = 8πEND IFππIF aspect >= 1 THENπ surface = 7π ombre = 8π lumiere = 15πEND IFππLINE (xup, yup)-(xdown, ydown), surface, BFππLINE (xup, yup)-(xdown, ydown), ombre, BπLINE (xup + 1, yup + 1)-(xdown - 1, ydown - 1), ombre, BππLINE (xup, yup)-(xup, ydown), lumiereπLINE (xup + 1, yup + 1)-(xup + 1, ydown - 1), lumiereππLINE (xup, yup)-(xdown, yup), lumiereπLINE (xup + 1, yup + 1)-(xdown - 1, yup + 1), lumiereππLINE (xup + 3, yup + 3)-(xdown - 3, ydown - 3), couleur, BFππππEND SUBππSUB FormeSouris (SoftHard%, BMasque%, CMasque%)π'** Définir l'apparition du curseur de la sourisππ R% = Interr%(&H33, 10, SoftHard%, BMasque%, CMasque%) '** définir FormeSourisππEND SUBππSUB getsouris (Mode%)π'** Chercher dans SourisX%, SourisY% et SourisK% la position de la souris et l'état du boutonππ R% = Interr%(&H33, 3, bx%, cx%, dx%)ππ sourisk% = bx% '** bouton (1=gauche, 2=droit)π π IF Mode% THENπ sourisx% = cx% / 16 + 1 '** position X (mode texte)π sourisy% = dx% / 16 + 1 '** position Y (mode texte)π ELSEπ sourisx% = cx% '** position X (mode graphique)π sourisy% = dx% '** position Y (mode graphique)π END IFππEND SUBππSUB initsourisπ'** Initialiser le gestionnaire de la sourisππ R% = Interr%(&H33, 0, bx%, cx%, dx%) '** initialiser le gestionnaire de la sourisππEND SUBππFUNCTION Interr% (Num%, ax%, bx%, cx%, dx%)π'** Réaliser l'interruption numéro Num% avec les contenus des registres de AX% à DX%ππ IF PM%(0) = 0 THEN '** PM%() est initialisé ?π PRINT "ERREUR : programme machine absent ! Arrêt!"π ENDπ END IFππ DEF SEG = VARSEG(PM%(0)) '** définir le segmentπ POKE VARPTR(PM%(0)) + 26, Num% '** mettre en oeuvre le numéro de l'interruptionππ CALL ABSOLUTE(ax%, bx%, cx%, dx%, VARPTR(PM%(0))) '** appelππ Interr% = ax% '** valeur retournée prise dans AX%ππEND FUNCTIONππSUB ReadDataπ'** Lire les DATA pour le programme machine dans PM%()ππ RESTORE MS.Dataπ DEF SEG = VARSEG(PM%(0))ππ FOR i% = 0 TO 99π READ Octet$π IF Octet$ = "#" THEN EXIT FORπ POKE VARPTR(PM%(0)) + i%, VAL("&H" + Octet$)π NEXT i%ππEND SUBππSUB SetSouris (X%, Y%)π'** Définir la position du pointeur de la sourisπ'** X% et Y% sont en coordonnées caractères en mode texteππ R% = Interr%(&H33, 4, bx%, X% * 16 - 16, Y% * 16 - 16)ππEND SUBππSUB souris (OnOff%)π'** Allumer / Eteindre le pointeur de la souris (0=éteint, 1=allumé)ππ IF OnOff% = 0 THEN OnOff% = 2 ELSE OnOff% = 1π R% = Interr%(&H33, OnOff%, bx%, cx%, dx%)ππEND SUBππSUB TempoSouris (Speed%)π'** Définir la vitesse de la souris (0=rapide, 100=très lente)ππ R% = Interr%(&H33, 15, bx%, Speed%, Speed% * 2)ππEND SUBππSUB zonexsouris (X1%, x2%)π'** Définir la zone de déplacement horizontal de la souris de X1% à X2%π'** X1% et X2% sont des coordonnées caractères en mode texteππ R% = Interr%(&H33, 7, 0, X1% * 16 - 16, x2% * 16 - 16)ππEND SUBππSUB zoneysouris (Y1%, Y2%)π'** Définir la zone de déplacement vertical de la souris de Y1% à Y2%π'** Y1% et Y2% sont des coordonnées caractères en mode texteππ R% = Interr%(&H33, 8, bx%, Y1% * 16 - 16, Y2% * 16 - 16)ππEND SUBπGerald Filimonov ANIMATION FACTORY V1.0 kwmelvin@nr.infi.net 03-26-95 (12:50) QB, QBasic, PDS 137 8847 ANIFACT.BAS 'Animation Factory 1.0, Copyright, 1995, All Rights Reservedππ' This program was created using Qbasic, a programming language that comesπ'with most DOS packages.ππ' This program will allow you to edit a series of frames and play them π'back in a certain order. You may choose between four colors and a couple of π'editing techniques, such as Cut,Copy,Paste,DrawLine, etc.ππDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"ANIFACT.ZIP",4^6:Z&=6074:?STRING$(50,177);πU"%up()%9%%%I-%:0/ICzA;:oK3R%%(=%%%1%%%%fs%nrfy%jWSg7fxfB):B?^lk4πU"zuIDyczR3']5a+lo5?7;o5?,:9&ZW9OLd]OmF1w:R4n?'pdJ>I\52s%:5X3o'BPπU"ENUHE-)RDc0MTFY-qF%\6m?>&.44SQulErrhb:n[>>q7p+RbeWD<I+Fqg'arFxhπU"Hu$0l>WnLqk27NNhmeT_X&5-U%ZfVG&l6rC/0S3IZ]x?=s]#f#,;jEi#$=;'f=tπU"8u3\/6u</wqo=C.5u\%))9>&$.9>/$.C]Id45z//&p&5w8gQb2jm#9S.OP((sK(πU"YZYdCuw)=9pr'6&.)M'&m]%vrZZgWa)%yJ1nC5u$LFgLenj%I?D;I\(e0]D%W:<πU"iHmZ-7U(*iKe$VIeRq^zZv'?)0L,:+Yu;yPw_PnX(1$6'q7*.vX9RV'Sk-WW+\kπU"6lDsX1iB1PZ?AZN5EQ></b>=X$6.pf.bnUh'Q-XfXq%:-YlG-E-4h2reA'b2nP*πU"4>zdRr6)9i%0I4PZgMlPOcV]pIJjTvz*b+K=qA:3538l;u/l&o1l\R3o(l:;GblπU"UsxL$X#VYo$Vz2z=V17Shq0YAw)'a),:Tmd/5b+MsB<U-n?$01-nIUhr4dnYPgQπU"cF_/BnllhGV>vp6?lB[ke>;$9DU%E:]0e[Z_N:Tu42x:QKh0$12VR7QC;b2QLg/πU"6lqMiW%VMf33m4TbKMKG?GH9#mMRGJh,IYuEB/G5\[r5BDnqF1EZG<6CE%MvnF[πU"34gCuq>Y5HhtBIs:KK35QMeB.LL-nlL$d\YvB]cZV\ix%Gg'mVi,(+kxPBS.0TMπU"6A\w<Q+50dID(vek;+$xm%8:3*Xo]ZP]%u9lXjpiOXoV#rt?m&G1lNKIFb1c>j1πU"ureE#rANs]iTwWr_Iv.F%Nk6xQRqCcba0=t2>(*:Y==HV:F/IB%yuU+S'pKI5y9πU"9;nf'C-+fO?J7D-&oU.EBeV'Z_D-gY\3$,;/J+G-W$ij1&35%C^#k5).(%2x7('πU"oEXkRIO]9d(YQQMOO]8'e3'Fg=D99I_=)S;(m$*4f1^&O841ES:%Z1A/PD/,1l8πU";R:+'xi?m[s-)x>sja#a)r-.Tlf\C.DW_?dd57%>8rv+*;k&=i>WP9%<-UZb]qxπU"88B6&sSV,f=90lP[iBWs0=9%NIBJgtU_fML:3a^)hc3XKQe)rMFQw^fYTV5&W'sπU"7pDU4R4Ju)#A0C75G%t/sPe0on;=RXG4[TWGV]GcRy#ARbooEAP>b9%3n2*fFI_πU"B5-goVFs\^hU3s;k84Ska'g;[u(N]h+Xr1.=$[PjNbI_+Vn.o^*+-Z,oQ8D0\0(πU"w_O+V[c)XoH1=$\8jpwAE)aFjAeAS]+q+UMN=Y4Z;8JV$shco5Bf,v=R$$4_t:EπU"82)Q)Z59eVOp7sb[XM=4Os'hBJ&u<\f:t$p&+RJPHvXc;ll_Z8<wT(]X3.fqBF_πU"A(P3?aiLJD8fZ094bJW=sB=P:Wrt]ms%Y/[=AUdD]H+#sPni/2<F(O2,XlrszC?πU"FAl*etI0OH8\&E3%xL)pzDejxKfgVEz\b?%$3*gwFB>?%$Nh$Sl_.\a:tb7qYYhπU"bCD*[Fz>=4guKKMcEUc-N587v)sccY'$t??uV*>AJc5Z#:$3w-GFsgql1Pvs%IeπU"$6\.TAi]SHj+\EV5_*rTE#4/+#*nH_n5[4ct;%<Q7\<oMbr:mrZzUNs3cKSa>=kπU"m#j$QF6R&iTjz6VR&TXDV2TxE(EJMYJlMx;bi$RhIV2#qi:K)\I/f_4ic/sqqF9πU"t8N'j,%hz\mY]\LKKj,5V+KDR2(SST8i9N$+ebQ(mtDp0X8e&f$.0u3h]A\IDmuπU"uo$-Q8mh-b_2NZ4#Km.E#E9^q)0bpH/wo$'VIdGI.'xZM]Yc8jr3-bnp+7--RViπU"\mBGHSS-gq%=(YT%k;aCSFZCl:nqij0VQ+MjzU,S7XZTM:&CAcB0Y^g2#$8Q4'+πU"hd>_^<GTq,B]ZxWB4_Cvno4b1>GrRl*hFVGE5m?W]Q*\6h<nqvE3Wn?i=p.70q1πU"hU>UCjdrkfRzuZY>.&_XsR+4b'Op_1jb==RWOI$=VuA$4:WrhZ6#\ICW%k\V*/DπU"D-^1eOW#y+]]qWE*4P6T,,)ASOaGkw%;7&xBI:ln4<q5:\<;&7m:;jvPLK0W7mgπU"<<ajd0iZZ\:)nTF]'&I_S&y3.Iu5$;jAZSwxobgl,044F56M_?^%pN[h>&+XJ:gπU"H.vsejGF$L(yf^?4gT>3M^'RQ9MYRfi76+hInK;PMGAgb^)nvfCInS*/<?9EgLvπU"K]/=nqP]eHA:CT\[vX_Jcw1BLNgS+?Vo;fv=:Sm#iNl<0$mk7g<37&6Fk9.eU_-πU")c>3.[(h9JpKENF>g.7(_e)k=HsvKa>qDQZ%m<Z<%sgs[s=*fP=\Q3g?l%,uNoXπU"/-GUqf.]^5)&-/'TLfovEp1y8h>xO_kPX9j&&o]VJO>*$rjMk(JbTef?KhO4o82πU".;o+rS-*E5z$bP%\ExhR(X^b5mSlacCU7LLh#K+\__l+*?UBh#q0D;c[[N.>n0&πU"5$hZS$]Gfu+3'_wFO)S(eaVK^2'nbDJfR8[%nWp$.Ull=nX^S=b[E8<Z1\:ha>ZπU"Xl5N?k<8oSH^gBL$u]x0pa0lRxn5mR1gEUAB9Fu63u,u]&rI74m>[qneNb9<y>/πU",wMrHU#k#M69-QK[cM-/#lvgssE8)ORlV0)[hZTYE#u#5H<y?Sm]/sg_VXp8><AπU"n8^qZC%1P#6Uj9[PJ-q%#2'Pi&-9L%1mFUtiAfV]s&a%o9D+d/B[>DGlAI^DWU2πU"s173b83h7=t3:Qk%X+Y+e-:/wNtq[)p>?=wZ97L;+;3g*KyY)QH_a=^wvW??xafπU"Cl4uAY<HN30FlK$TrAIK+8X_n76pu=;i[jK;f/XnL[[bnr)MN21oeE1PI5*wAkJπU"v/5#*kQhRhg#alE2c(,Y76&)N&]D$^t4iaTZt3MLs7+g9>O7F7Ne./+mr6pNBHZπU"K-5wqhGuij6RbmmhtCA/h<pM(%6wzi3zORDT2,\).KRA2*oX;,v3py=;[jYma7>πU"qOMN1&q(?)m:I5QV#9pg,)uFY4%eR2whsub:<5Rr=*&evW7gwC4NjA8xQamSb/1πU"sW%I8N;bahdk.YqAgDE$QzTj:A*P7P#)XWT$wjtVbmMuMC/riUe%:5z<d/>#BEXπU"MfX:t3['zMp^4]:Vx%qz1ts:bh$)(gmXq]8q$8JU5Qhu(Ae^UFH$3X;c.NWVV<-πU"O/$kD_tbaMY<Mka%K3edr:,jlGikafV8/>=dsP]]Xv8AlG&f\IW76bsA(#K-HpLπU"?Ese4dhm]E<E+3YXwd&0$aya;V6jJiX$5m=p'*waL6k#^'jw'SR;co*UOLJnGpgπU"(=oh+n3>Pxw%1Jt$&WFLD$ZUOp:,FMfkzlpfr8<o(<qUc_nm-(mrbSb\DORzYJLπU"wdTU'a_C**+6+Mn$55Zp&LMr\S#0f)H+_T<sqP4LlpPluYdrr]fZmbfNWb;eABvπU"+,7WEU,xO=77D]tj[Bb*a2L+:?$rekc[SPLMmk8mT?YH]_87qIko0#&by5cJm88πU"J;c-4c8LoUd3_74tqT:Itg:TMS17P0-:-AvT#u(+*pgz2f>PqNsO:Lc*El\kxJtπU"2$aPCm3X;<.p&[e7PIkqMR-+p:+-k[pbnwuaeFoM_LcYAwuLtXiDW:]M'ogGwJzπU"pNO?Gj7<T>B%b2uE&6'0Zqmym)5KBZSGt<+mI8w.z-LLYJ>9=2Sh7<HUQ?[w\p?πU"R;<bZu),+;VJZpO1JVINN&;Xt+;shm[85R$KwCkD8],>f[BK'GJkt_e:Mr,z^k:πU"0vlTtVtlI\0Lno)]3OlTAyo.CIrSPu\agVBkTh^<';Jkqkq^AsB1zX0K_Nxt%)[πU"e)17[U4mA0KdER-RJi%$3CsK<86Bin0Gie\>As+8t[n5DO:/E^(zOZ^K)Bo?hSbπU"_6k95&o=X^oaZv(^c<RR2g2ZSd/6AU\\4gm.NhQWHo57bDJ[oo7OhOmxTqpPL7fπU">[mfK7=CD>Rjm&[ZOJ%lHXW/gnhtJ0$De>uKa4$wC7;w7$tPtt434byvX>R?ziBπU"1t'Tgzb\G9-z4*<h_=XaNad#P^Y&N6D=7i_ShkQ5(0&5+^XPH^HiQIJG%Oe\%gqπU"J?8vyjlLn6FSF&\(/3(]$RrTNmJqGRZ)daZ=h6]#:/QWoS\7Ze\+W=sUbA%bEcIπU"AsE'RIqHHaO5Jr(dj0aMtas)v%a:3SlsG9;RDXB_VyHS<]%i$]xG+DwTJ)7cq']πU"6BL06s'.ZgzU%F?N?CPsyca9?,5h\Z=&I3%CHqC:Pvm2(^u8iAbO'm(c/.;O%:6πU"-/To4hhzxYQYXwr\ivba)spvEDNwJAabmmmHW\eNvJ[*1n>8K7#5gw4Il]tPb;-πU"B3Aocowm7W.Pd8ycu<Z.9&K/;pnb#w,/&1qz\5:e?2sP$)Gj-Qq5>h?#c0zNπU";)=\[,]rptat2AQsqfw%dTYoj\a94n5\%qD,eJ9ncjUYx:5;O;q:P.WZZ)(I<paπU"n3nZYvn$n=9bSlF]3U:f+[8Bj;^?+Rik'T[aZMgayGREglyeGdg[S0f9f;sG_2qπU">*=I%W'NN-WO2t_A%ROU':6J6ViMal6<12$ok(JaKvYIkn&s(Pq.r7Njb-D5&ikπU"+i?q:uW5&sf]XHCmr'Vfgorl]A(6WQl+ub,(M78W*YY^7\0_H[X=QJ+paTOn&1IπU"=gw%9L2:I$R7ttOOCpWUY0RfKbV;<ZqiAhYUX#\r9qF*'tCLiZ8y3OM.AlI/2I&πU",_sAQ.USlsoP4sj9e+Da(9qi*.7X^R>[Nv?j);&[hN1_Q:;z^?jk7&DiFbMj2/ZπU"]P;d3x(%up()%9%%%I-%+5JICm.&;eq(m%%OA%%%0%%%%fs%nknq%jSngjVfl:/πU"9809IkLTO;Cl1;P&jNYBY898OD>L?Gtl9#5%\L75FgL<c:xs-HWt28s..=q,n,MπU"A7$IlhE82?tZvjvLrPLt3cd/B-<>lIfZL-QO^vK5hW>Z1llRnMmGMnaI\-?%&4\πU"939(KrV>>dBaka>^EWDZfl+u(P#LZ$Lth6V(mlBGp(o9r+AM.qk2W:ObJ:C>4TrπU"UB3Mrh[-,(uP#L$lLthXE(mLn\f+ed#2MWY\-kXAAwk>l'BMrkJ:W9blJH+(lP#πU"b$uLtJtZNlaHn8%-WGOs<rifR-NM$K[-4l-XcBQ=lCjZS_U:on6TQRp8StBPd^uπU"jmrmkMmM^1aI-?a%F\Y2y]1<Tujn&Q:(Z\?ta62TB,dbh^%aTpK\gSRca[A06cmπU"cknW^U$(mlGdp(orX+MJ(qIDv3<7)W*lXM&L9Jp*c_H>JrLUuwck#A=Pj44-(;^πU"vHLWprpzZ$B$t[&e(S/MpO+d%27t%R&?%pYof0^)7%I>O/X7&o&e(QSw=O#+%2oπU"#&Y%7.%2o&R5#)imcS/8Hxuyv[&Y%S>=9^Z8S+I%/W2'Do7A/VBvk<Fi06;;0l\πU"S+fI%_pU(ekx0n[x\CFKwi_#H2jgrSUI^%o&S;OvsdWW_UOlN-har7xa7u2a7B'πU"Q5?%=YY+?$kF#)ei[j5e=_HV3u#v&#e(s:T9w7Ke6c,8ec,^gAj-c<4K3>O$3>SπU"3S>W3>U[HVCuk3r\.s(O+kkOO>QmNJJlU0MvOOqn&7(,prU)NdjPXgjYigjZgVjπU"[gjCr-\lr5=w10L%o&nvZYihTKBUt>usafpDM28>Gq$fXqCXUyCX+PCX3CrX;k3πU"lb]Dl%4]2%1??)(uObTxu2(cnuZTfbmJek3YXH:.QOFKY8-\nKYIVUfiaDbBrd5πU",p=JtWCAA?%\-v4%#,M[4*i]F[95hxN%R#cXU&8%aps(Qi>_;g+90,YO2Hlt+pTπU"j+)0%?%r\8O2L%G75&;Ag+eZQ-tBS&7%2%%?%%Y(%O+%%%2%%%?%%Y.%%7%+%I%πU"%\o&%i'xh(%\7%%I.%%o&%%e(%&O+%%%2%%?m%%Fi%8up(%)9%%#%-%+)5ICTVqπU"K;Z[%%%O'A%%0%%%%f%snkn%qjSnmgWfM%f2%ER1))beU&SEX*kqp\7.KqiJY7HπU"4oG->=&w^%8?%Y%09&O(%%,%3%%A%]^%?%YF%9&O%(%,%%3%A%.]%?%9Y%9&&O(πU"%,%%3%A#%]%?a%Y%9(&O(%%,%3%%A%]%8?%Y%09&O(%%,%3%%A%]^%?%YF%9&O%πU"(%,%%3%A%d]%G[%'up(%)9%%#%-%<)?ICNS%2aB%(%%7%,%%/%%%%w%jfir#jSyπU"'(yLyr,BT[5$6:kx\0Lbmduk2DN.,FuO,>])N4Yt'7sXB2(GfIKUEe:Vs=vtgg7πU"qt?^st0jli)>pBf'Xz##:Y(Dgza_uT:b]LIR:9JFs&DuAYmcKcaRhFViEOnV,maπU"3/'[l-\JlY#^Z-P-Y>m8m5;ihH*OC)(ldx2bCChg%u*QEDI<PGf8v-$g>wPLg-9πU"c&Dqy]MK&'Wa(D^_B;97A,W1('pFzr<5?qBDgkil%?#u,$Y&aK;_K)/fo0J(duUπU"W^8cCRoZ9T#wQ?0O#]0'SWZlI<9N$aPIrYO8#8g,fPiC20RphB-uwCDkpFfG1j^πU"Yf&f$Y&?GP:O*E:z98km>rqgP9Us+#_>XZRoWrOR\FxVg*]E%hwXyOESDi1zBGMπU"X>(:_3gR\C92dZ/&<+6,.k+&6n[]<6XK=4SP#O=*R7tVMa59-A[S^1zr8Fc.,e(πU"#P0#,XzasYZ1K9nDJ84m<?r7T*0_P0E7%3bMJLVWddB:%R1OoX48ji2Fq&AioE1πU"GTtLZ-q/G&3J1'bZcU9v^C99.EaMzGtZ37wv/7eI4YARqWmusvjAS1,%um7hB?#πU"e#1L-bpL_o>CG.HJe/<PNEkmPk9Q;iN7]xuLme#NE:r<pEj:\Lbk,-Vm-u.=',^πU"'qMVrfu[oVk5Mr^uk^xL5TaAS/VE?tB[(W(eDn[;J-pu3smLLINF_(xR-.FrQ\?πU"aw5Me=;d0L=EWa>HlmA8gBTUc;_\gSgb.<JgP*VDe6=0Iknf78rIWiimTt\KoM.πU"e$ffbQbTy)3.0>j]()*LNlZC4AozkuVz>G..MRb&iEl=t_9gR$[pyF3Wv4&xAb^πU"zHt]WD/PddI?A/a_MSVIiz_.-&uf:3Y]hVePPFl92&H<IzQ-WJ;df-X*mn^C\8sπU"B\57ru]09(w7<,JG]HMSOCbih*V]Jn.4awHaR&$V+]-vlxV0]0m>FDs)K?Cgu'$πU"/a'VLajC8T2$5D1&KoQV*arJ4iV,Qh1oL3I$C)LK9bGn[&TW_^#\/Q7/mEzE2<VπU"[%8i+%*UOH,Ss9_-)a/qmkZMM\7BiRINQM):*h1Lp^h[BBTw*WFSoST4tAu]r]^πU"hvpzfh]&>K^o-zGW?/jUK7VKB>O^*b6U*N&%up&'%9%9%%%%-%2:0ICJzA:o'K3πU"%%*(=%%%1%%%%%%%%%&%E%%%%%%%%%fs%nrfy%jWSg%fxup%&'9%%9%%%I-%+5JπU"ICm.&;eq(m%%OA%%%0%%%%%%%%%%%%E%%%'u3%%%fsnk%nqjS%ngVu%p&'9%%9%πU"%#%-%+)5ICTVqK;Z[%%%O'A%%0%%%%%%%%%%%%E%%(%#7%%%fsn%knqj%SngW%uπU"p&'%9%9%%%%-%2<?IC^N%2a&B(%%%7,%%%/%%%%%%%%%&%E%%%%J8%%%wj%firjπU".Sy'y%up*+%%%%%%)%)%']%%%'9;%%%%%πEND SUBπCLOSE:IF S=204AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπSteven Sensarn RAY CASTER WITH KEYBOARD ISR comp.lang.basic.misc 08-17-96 (20:04) QB, QBasic, PDS 519 20378 RAYCAST.BAS 'Here is a new version (I merely added my keyboard ISR to the last). Don't beπ'afraid to hold down multiple keys! :)ππDECLARE SUB screensetup ()πDECLARE SUB makeworld ()πDECLARE SUB maketables ()πππDECLARE SUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)πDECLARE SUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)πDECLARE SUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)πDECLARE SUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)ππ'$STATICππCONST NUM.KEYS = 10πCONST INDEX.UP = 0πCONST INDEX.DOWN = 1πCONST INDEX.LEFT = 2πCONST INDEX.RIGHT = 3πCONST INDEX.CTRL = 4πCONST INDEX.ALT = 5πCONST INDEX.SPACE = 6πCONST INDEX.ESC = 7πCONST INDEX.ENTER = 8πCONST INDEX.RSHIFT = 9ππDIM SHARED KEY.TABLE(0 TO (NUM.KEYS - 1)) AS INTEGERπDIM SHARED RAWKEY AS INTEGERπDIM SHARED OLD.ISR.SEG AS INTEGER, OLD.ISR.OFF AS INTEGERππCALL KEYBOARD.IN(OLD.ISR.SEG, OLD.ISR.OFF)ππ' Just a minor change, but it's good for a speed increaseπ' of about 30% on my P133. Changed the LINE,BF to draw theπ' walls into seperate LINE's.ππ'=======================================================================π' RAY CASTER 3D sorta ENGINE thingymajigπ'=======================================================================π' Wrote this about a month ago, it's a sort of wolfenstien\doomπ' lookalike but all in native QBasic source! Uses an interesting rayπ' Cheers, {:o) Peter Cooperππ' Clean-up by Brent P. Newhallππ' Improvments by Nick Cangiani (nicksxe@gnn.com)π' Sped up maketables by v Zoelen AA (vsim@xs4all.nl)π' Minor improvement by Marc vd Dikkenberg (excel@xs4all.nl)ππ' Left arrow == Move leftπ' Right arrow == Move rightπ' Up arrow == Move forwardπ' Down arrow == Move backwardπ' [ESC] == QuitππDIM SHARED st%(0 TO 360)πDIM SHARED ct%(0 TO 360)πDIM SHARED a$(1 TO 10)πDIM SHARED grid(1 TO 12, 1 TO 12)πpx% = 15: py% = 35: sa% = 0πPRINT "Please wait...";πRANDOMIZE TIMERπmakeworldπmaketablesπscreensetupπm% = 1πDOπ IF m% = 1 THENπ IF P = 2 THEN PCOPY 2, 0 ELSE PCOPY 3, 0π IF P = 2 THEN P = 3 ELSE P = 2π m% = 0π END IFπ FOR t% = sa% TO sa% + 59 STEP 1π xb = st%(t% MOD 360) / 100 'get incπ yb = ct%(t% MOD 360) / 100 'get incπ bx = px% 'decimal copyπ by = py% 'decimal copyπ l% = 0 'reset lengthπ DOπ bx = bx + xbπ by = by + ybπ l% = l% + 1π 'k% = ASC(MID$(a$(CINT(by / 10)), CINT(bx / 10), 1)) - 48π k% = grid(CINT(by / 10), CINT(bx / 10))π LOOP UNTIL k% <> 0π 'LOCATE 1, 1π 'PRINT l%; 'this would print the distance to wallπ X% = (t% - sa%) * 5π dd% = (1000 / l%)π 'LINE (X%, 1)-(X% + 5, 99 - dd%), 15, BF 'paint ceilingπ 'LINE (X%, 101 + dd%)-(X% + 5, 200), 2, BF 'paint floorπ 'LINE (X%, 100 - dd%)-(X% + 5, 100 + dd%), k%, BF 'paint wallsππ FOR U% = 0 TO 5 'paint wallsπ LINE (X% + U%, 100 - dd%)-(X% + U%, 100 + dd%), k%π NEXT U%π ' Could be even 20% faster: FOR U% = 0 to 4π ' This will skip one line at the right of the screen, though.ππ LINE (X%, 100 - dd%)-(X% + 5, 100 - dd%), 0 'top linesπ LINE (X%, 100 + dd%)-(X% + 5, 100 + dd%), 0 'bottom linesπ NEXT t%π PCOPY 0, 1π RAWKEY = 0: WHILE RAWKEY = 0: WENDπ IF KEY.TABLE(INDEX.RIGHT) THEN ' [LEFT]π sa% = sa% + 3π m% = 1π END IFπ IF KEY.TABLE(INDEX.LEFT) THEN ' [RIGHT]π sa% = (sa% + 357) MOD 360π m% = 1π END IFπ IF KEY.TABLE(INDEX.ESC) THEN ' [ESC]π quit = 1π END IFπ IF KEY.TABLE(INDEX.UP) THEN ' [UP]π Oldpx% = px%: Oldpy% = py% ' Save where you areπ px% = px% + (st%((sa% + 30) MOD 360) / 30)π py% = py% + (ct%((sa% + 30) MOD 360) / 30)π IF grid(CINT(py% / 10), CINT(px% / 10)) > 0 THEN 'Walking thru walls?π SOUND 80, 1π px% = Oldpx% ' Forget it! Don't moveπ py% = Oldpy%π ELSEπ m% = 1π END IFπ END IFπ π IF KEY.TABLE(INDEX.DOWN) THEN '[DOWN]π Oldpx% = px%: Oldpy% = py% ' Save where you areπ px% = px% - (st%((sa% + 30) MOD 360) / 30)π py% = py% - (ct%((sa% + 30) MOD 360) / 30)π IF grid(CINT(py% / 10), CINT(px% / 10)) > 0 THEN 'Walking thru walls?π SOUND 80, 1π px% = Oldpx% ' Forget it! Don't moveπ py% = Oldpy%π ELSEπ m% = 1π END IFπ END IFπLOOP UNTIL quit > 0πSCREEN 0πWIDTH 80, 25πππCALL KEYBOARD.OUT(OLD.ISR.SEG, OLD.ISR.OFF)πππSYSTEMππ' Level data (this way you can have walls colored 10, 11, etc.)π' 12x12πDATA 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9πDATA 9, 0, 4, 0, 0, 0, 0, 0, 0, 5, 0, 1πDATA 1, 0,12, 0, 0, 0, 0, 0, 0,13, 0, 9πDATA 9, 0, 4, 0, 0, 0, 0, 0, 0, 5, 0, 1πDATA 1, 0,12, 0, 0, 0, 0, 0, 0,13, 0, 9πDATA 9, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1πDATA 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 9πDATA 9, 0,12, 0, 0, 0, 0, 0, 0, 0, 0, 1πDATA 1, 0, 4, 0, 0, 0, 0, 0, 3,11, 0, 9πDATA 9, 0,12, 0, 0, 0, 0, 0,11, 3, 0, 1πDATA 1, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 9πDATA 9, 1, 9, 1, 9, 1, 9, 1, 9, 1, 9, 1ππ' Old level. If you want it, come and get it.π' 1, 9, 1, 9, 1, 9, 1, 9, 1, 9π' 9, 0, 0, 0, 0, 0, 0, 0, 0, 1π' 1, 0, 0, 0, 0, 0, 0, 4, 0, 9π' 9, 0, 1, 0, 0, 0, 5, 0, 0, 1π' 1, 0, 2, 0, 0, 4, 0, 0, 0, 9π' 9, 0, 3, 0, 0, 0, 0, 0, 0, 1π' 1, 0, 0, 0, 0, 7, 8, 0, 0, 9π' 9, 0, 5, 0, 0, 8, 7, 0, 0, 1π' 1, 0, 6, 0, 0, 0, 0, 0, 0, 9π' 9, 1, 9, 1, 9, 1, 9, 1, 9, 1πππSUB GETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)ππ 'GETVECT RETURNS THE ADDRESS OF A FUNCTION POINTED TO IN THEπ 'INTERRUPT VECTOR TABLE (STARTS AT 0000:0000H)ππ STATIC ASM AS STRING 'THE CODE FOR GETVECTππ STATIC INI AS INTEGER 'USED TO DETECT WHETHER GETVECT HAS PREVIOUSLYπ 'BEEN CALLEDπ IF INI = 0 THENπ π 'CREATE ML FUNCTION IF NOT ALREADY CREATEDππ ASM = ASM + CHR$(&H55) 'PUSH BPπ ASM = ASM + CHR$(&H89) + CHR$(&HE5) 'MOV BP,SPπ ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]π ASM = ASM + CHR$(&H8A) + CHR$(&H7) 'MOV AL,[BX]π ASM = ASM + CHR$(&HB4) + CHR$(&H35) 'MOV AH,35π ASM = ASM + CHR$(&HCD) + CHR$(&H21) 'INT 21π ASM = ASM + CHR$(&H53) 'PUSH BXπ ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0A]π ASM = ASM + CHR$(&H8C) + CHR$(&H7) 'MOV [BX],ESπ ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV BX,[BP+08]π ASM = ASM + CHR$(&H58) 'POP AXπ ASM = ASM + CHR$(&H89) + CHR$(&H7) 'MOV [BX],AXπ ASM = ASM + CHR$(&H5D) 'POP BPπ ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0) 'RETF 0006π INI = 1 'FLAG CREATIONπ END IFππ DEF SEG = VARSEG(ASM)π CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN FUNCTIONπEND SUBππSUB KEYBOARD.IN (OLDSEG AS INTEGER, OLDOFF AS INTEGER)π DIM RSGL AS INTEGER, RSGH AS INTEGER 'SEGMENT OF RAWKEYπ DIM ROFL AS INTEGER, ROFH AS INTEGER 'OFFSET OF RAWKEYππ DIM KSGL AS INTEGER, KSGH AS INTEGER 'SEGMENT OF KEY.TABLEπ DIM KOFL AS INTEGER, KOFH AS INTEGER 'OFFSET OF KEY.TABLEπ π DIM BYTE AS STRING * 1 'USED TO ACTIVATE IRQ 1 IN PICππ STATIC ASM AS STRING 'HOLDS ISRππ RSGL = VARSEG(RAWKEY) AND &HFF 'LOAD LOW "BYTE" SEGMENTπ RSGH = INT(VARSEG(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENTππ ROFL = VARPTR(RAWKEY) AND &HFF 'LOAD LOW "BYTE" OFFSETπ ROFH = INT(VARPTR(RAWKEY) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSETπ π KSGL = VARSEG(KEY.TABLE(0)) AND &HFF 'LOAD LOW "BYTE" SEGMENTπ KSGH = INT(VARSEG(KEY.TABLE(0)) / 256) AND &HFF 'LOAD HIGH "BYTE" SEGMENTππ KOFL = VARPTR(KEY.TABLE(0)) AND &HFF 'LOAD LOW "BYTE" OFFSETπ KOFH = INT(VARPTR(KEY.TABLE(0)) / 256) AND &HFF 'LOAD HIGH "BYTE" OFFSETππ 'THIS IS THE ISR. IT READS A SCANCODE FROM THE KEYBOARD BUFFERπ 'AND RESETS IT. THE BEST PART IS, BIOS CAN'T TOUCH IT!ππ ASM = ""π ASM = ASM + CHR$(&H52) 'PUSH DXπ ASM = ASM + CHR$(&H51) 'PUSH CXπ ASM = ASM + CHR$(&H53) 'PUSH BXπ ASM = ASM + CHR$(&H50) 'PUSH AXπ ASM = ASM + CHR$(&H6) 'PUSH ESπ ASM = ASM + CHR$(&H57) 'PUSH DIπ ASM = ASM + CHR$(&H1E) 'PUSH DSπ ASM = ASM + CHR$(&H56) 'PUSH SIπ ASM = ASM + CHR$(&HFB) 'STIπ ASM = ASM + CHR$(&HBA) + CHR$(&H60) + CHR$(&H0) 'MOV DX,0060π ASM = ASM + CHR$(&HEC) 'IN AL,DXπ ASM = ASM + CHR$(&H30) + CHR$(&HE4) 'XOR AH,AHπ ASM = ASM + CHR$(&HBA) + CHR$(RSGL) + CHR$(RSGH)'MOV DX,SEG RAWKEYπ ASM = ASM + CHR$(&H8E) + CHR$(&HDA) 'MOV DS,DXπ ASM = ASM + CHR$(&HBE) + CHR$(ROFL) + CHR$(ROFH)'MOV SI,OFFSET RAWKEYπ ASM = ASM + CHR$(&H88) + CHR$(&H4) 'MOV [SI],ALπ ASM = ASM + CHR$(&H50) 'PUSH AXπ ASM = ASM + CHR$(&HBA) + CHR$(&H61) + CHR$(&H0) 'MOV DX,0061π ASM = ASM + CHR$(&HEC) 'IN AL,DXπ ASM = ASM + CHR$(&HC) + CHR$(&H82) 'OR AL,82π ASM = ASM + CHR$(&HEE) 'OUT DX,ALπ ASM = ASM + CHR$(&H24) + CHR$(&H7F) 'AND AL,7Fπ ASM = ASM + CHR$(&HEE) 'OUT DX,ALπ ASM = ASM + CHR$(&HB0) + CHR$(&H20) 'MOV AL,20π ASM = ASM + CHR$(&HBA) + CHR$(&H20) + CHR$(&H0) 'MOV DX,0020π ASM = ASM + CHR$(&HEE) 'OUT DX,ALπ ASM = ASM + CHR$(&HBA) + CHR$(KSGL) + CHR$(KSGH)'MOV DX,SEG KEY.TABLEπ ASM = ASM + CHR$(&H8E) + CHR$(&HDA) 'MOV DS,DXπ ASM = ASM + CHR$(&HBE) + CHR$(KOFL) + CHR$(KOFH)'MOV SI,OFFSET KEY.TABLEπ ASM = ASM + CHR$(&H58) 'POP AXπ ASM = ASM + CHR$(&HBB) + CHR$(&H1) + CHR$(&H0) 'MOV BX,0001--MAKEπ ASM = ASM + CHR$(&HB4) + CHR$(&H48) 'MOV AH,48--UPπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H0) 'MOV [SI+00],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H50) 'MOV AH,50--DOWNπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'MOV [SI+02],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H4B) 'MOV AH,4B--LEFTπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H4) 'MOV [SI+04],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H4D) 'MOV AH,4D--RIGHTπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H6) 'MOV [SI+06],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H1D) 'MOV AH,1D--CTRLπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H8) 'MOV [SI+08],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H38) 'MOV AH,38--ALTπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HA) 'MOV [SI+0A],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H39) 'MOV AH,39--SPACEπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HC) 'MOV [SI+0C],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H1) 'MOV AH,01--ESCπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HE) 'MOV [SI+0E],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H1C) 'MOV AH,1C--ENTERπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H10)'MOV [SI+10],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H36) 'MOV AH,36--RSHIFTπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H12)'MOV [SI+12],BXππ ASM = ASM + CHR$(&HBB) + CHR$(&H0) + CHR$(&H0) 'MOV BX,0000--BREAKπ ASM = ASM + CHR$(&HB4) + CHR$(&HC8) 'MOV AH,C8--UPπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H0) 'MOV [SI+00],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&HD0) 'MOV AH,D0--DOWNπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H2) 'MOV [SI+02],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&HCB) 'MOV AH,CB--LEFTπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H4) 'MOV [SI+04],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&HCD) 'MOV AH,CD--RIGHTπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H6) 'MOV [SI+06],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H9D) 'MOV AH,9D--CTRLπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H8) 'MOV [SI+08],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&HB8) 'MOV AH,B8--ALTπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HA) 'MOV [SI+0A],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&HB9) 'MOV AH,B9--SPACEπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HC) 'MOV [SI+0C],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H81) 'MOV AH,81--ESCπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZ π ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&HE) 'MOV [SI+0E],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&H9C) 'MOV AH,9C--ENTERπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H10)'MOV [SI+10],BXπ ASM = ASM + CHR$(&HB4) + CHR$(&HB6) 'MOV AH,B6--RSHIFTπ ASM = ASM + CHR$(&H38) + CHR$(&HC4) 'CMP AH,ALπ ASM = ASM + CHR$(&H75) + CHR$(&H3) 'JNZπ ASM = ASM + CHR$(&H89) + CHR$(&H5C) + CHR$(&H12)'MOV [SI+12],BXππ ASM = ASM + CHR$(&HFA) 'CLIπ ASM = ASM + CHR$(&H5E) 'POP SIπ ASM = ASM + CHR$(&H1F) 'POP DSπ ASM = ASM + CHR$(&H5F) 'POP DIπ ASM = ASM + CHR$(&H7) 'POP ESπ ASM = ASM + CHR$(&H58) 'POP AXπ ASM = ASM + CHR$(&H5B) 'POP BXπ ASM = ASM + CHR$(&H59) 'POP CXπ ASM = ASM + CHR$(&H5A) 'POP DXπ ASM = ASM + CHR$(&HCF) 'IRETππ BYTE = CHR$(INP(&H21)) 'LOAD IRQ ENABLE REGISTER IN PICππ OUT &H21, (ASC(BYTE) AND (255 XOR 2)) 'CLEAR BIT 2 (IRQ 1)ππ CALL GETVECT(OLDSEG, OLDOFF, &H9) 'LOAD OLD ISRπ CALL SETVECT(VARSEG(ASM), SADD(ASM), &H9) 'STORE NEW ISRπEND SUBππSUB KEYBOARD.OUT (OLDSEG AS INTEGER, OLDOFF AS INTEGER)π CALL SETVECT(OLDSEG, OLDOFF, &H9) 'RESTORE OLD ISRπEND SUBππSUB maketablesππ' Peters boring _yawn_ table creationπFOR tmp1% = 0 TO 360π st%(tmp1%) = SIN(tmp1% * .0174) * 100π 'IF tmp1% MOD 100 = 0 THEN PRINT ; ".";π 'NEXT tmp1%π 'FOR tmp1% = 0 TO 360π ct%(tmp1%) = COS(tmp1% * .0174) * 100π 'IF tmp1% MOD 100 = 0 THEN PRINT ; ".";πNEXT tmp1%ππEND SUBππSUB makeworldππ' Read in this level's dataπFOR j = 1 TO 12π FOR I = 1 TO 12π READ grid(I, j)π NEXT IπNEXT jππ' Peter Coopers demonstration level. Change it if you wish! Each numberπ' is a color numberπ'a$(1) = "1919191919"π'a$(2) = "9000000001"π'a$(3) = "1000000409"π'a$(4) = "9010005001"π'a$(5) = "1020040009"π'a$(6) = "9030000001"π'a$(7) = "1000078009"π'a$(8) = "9050087001"π'a$(9) = "1060000009"π'a$(10) = "9191919191"ππEND SUBππSUB screensetupππSCREEN 7πLOCATE 4πPRINT " RAYCASTER DEMO"πPRINTπPRINT " UP ARROW........Move Forward"πPRINT " DOWN ARROW......Move Backward"πPRINT " RIGHT ARROW.....Turn Right"πPRINT " LEFT ARROW......Turn Left"ππSCREEN 7, , 2, 0ππCLSπ'WINDOW SCREEN (1, 1)-(320, 200)ππ' SkyπLINE (0, 0)-(300, 99), 3, BFππFOR cnt = 1 TO 10 ' Cloudsπ a = INT(RND * 319)π b = INT(RND * 80 + 10)π c = INT(RND * 50)π d = INT(RND * 10): d = d / 100π CIRCLE (a, b), c, 1, , , d: PAINT (a, b), 1π CIRCLE (a, b), c, 15, , , d: PAINT (a, b), 15πNEXT cntπLINE (301, 0)-(319, 199), 0, BF ' Erase clouds on rightππ' Obeliskπ'LINE (200, 20)-(240, 99), 0, BFπ'LINE (201, 21)-(239, 98), 8, BFππLINE (200, 20)-(220, 15), 8 ' Building (gray)πLINE (220, 15)-(240, 20), 8πLINE (200, 20)-(200, 99), 8πLINE (240, 20)-(240, 99), 8πLINE (200, 99)-(240, 99), 8πPAINT (220, 50), 8πFOR cnt = 1 TO 20 ' Lightsπ PSET (INT(RND * 38 + 201), INT(RND * 80 + 20)), 14πNEXT cntπLINE (200, 20)-(220, 15), 0 ' Building (border)πLINE (220, 15)-(240, 20), 0πLINE (219, 15)-(219, 99), 0πLINE (200, 20)-(200, 99), 0πLINE (240, 20)-(240, 99), 0ππ' SunπCIRCLE (50, 30), 10, 14: PAINT (50, 30), 14, 14ππPCOPY 2, 3ππFOR Y% = 100 TO 199π FOR X% = 0 TO 300π IF RND > .5 THEN c% = 6 ELSE c% = 0π PSET (X%, Y%), c%π NEXT X%πNEXT Y%ππSCREEN 7, , 3, 0πFOR Y% = 100 TO 199π FOR X% = 0 TO 300π IF RND > .5 THEN c% = 6 ELSE c% = 0π PSET (X%, Y%), c%π NEXT X%πNEXT Y%ππSCREEN 7, , 0, 1ππEND SUBππSUB SETVECT (S AS INTEGER, O AS INTEGER, I AS INTEGER)ππ 'SETVECT CHANGES THE ADDRESSES IN THE INTERRUPT VECTOR TABLEπ 'TO POINT TO NEW FUNCTIONSππ STATIC ASM AS STRING 'HOLDS THE SETVECT FUNCTIONπ STATIC INI AS INTEGER 'USED TO TEST WHETHER OR NOT FUNCTION HAS PREVOUSLYπ 'BEEN CALLEDπ IF INI = 0 THENππ 'CREATE FUNCTION IF NOT ALREADY CREATEDππ ASM = ""π ASM = ASM + CHR$(&H55) 'PUSH BPπ ASM = ASM + CHR$(&H89) + CHR$(&HE5) 'MOV BP,SPπ ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8) 'MOV BX,[BP+08]π ASM = ASM + CHR$(&H8B) + CHR$(&H17) 'MOV DX,[BX]π ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6) 'MOV BX,[BP+06]π ASM = ASM + CHR$(&H8A) + CHR$(&H7) 'MOV AL,[BX]π ASM = ASM + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA) 'MOV BX,[BP+0A]π ASM = ASM + CHR$(&H1E) 'PUSH DSπ ASM = ASM + CHR$(&H8E) + CHR$(&H1F) 'MOV DS,[BX]π ASM = ASM + CHR$(&HB4) + CHR$(&H25) 'MOV AH,25π ASM = ASM + CHR$(&HCD) + CHR$(&H21) 'INT 21π ASM = ASM + CHR$(&H1F) 'POP DSπ ASM = ASM + CHR$(&H5D) 'POP BPπ ASM = ASM + CHR$(&HCA) + CHR$(&H6) + CHR$(&H0) 'RETF 0006π INI = 1 'FLAG CREATIONπ END IFπ DEF SEG = VARSEG(ASM)π CALL ABSOLUTE(S, O, I, SADD(ASM)) 'RUN SETVECTπEND SUBπThomas Gohel HIGHSPEED RAYCASTING FOR PB comp.lang.basic.misc 08-18-96 (00:00) PB32 519 14638 RAYCAST.BAS 'TWO Part Snippet (RAYCAST.BAS and RAYCAST.DAT to follow) [Requires UUDECODE]ππ'*************************************************************************π'π' Raycasting routines for PowerBASIC 3.2π'π' developed by Wolfgang Bruskeπ' new SCREEN 13 routines by Thomas Gohelπ'π'*************************************************************************πππ$COMPILE EXEπDEFINT A-ZππMinAbstand = 48πWinkel0 = 0πWinkel1 = 5πWinkel2 = 10πWinkel4 = 20πWinkel5 = 25πWinkel6 = 30πWinkel15 = 80πWinkel30 = 160πWinkel45 = 240πWinkel60 = 320πWinkel90 = 480πWinkel135 = 720πWinkel180 = 960πWinkel225 = 1200πWinkel270 = 1440πWinkel315 = 1680πWinkel360 = 1920πWeltReihe = 16πWeltSpalte = 16πZellXgroesse = 64πZellYgroesse = 64ππDIM WeltXgroesse(WeltSpalte * ZellXgroesse) as integerπDIM WeltYgroesse(WeltReihe * ZellYgroesse) as integerπDIM Welt(WeltReihe,WeltSpalte) as integerπDIM Tantable(1920) as singleπDIM Invtantable(1920) as singleπDIM Ystep(1920) as singleπDIM Xstep(1920) as singleπDIM Costable(1920) as singleπDIM Invcostable(1920) as singleπDIM Invsintable(1920) as singleπDIM Vptr as byte PtrπDIM Maxx as integerπDIM Maxy as integerπMaxx=(WeltSpalte * ZellXgroesse)-1πMaxy=(WeltReihe * ZellYgroesse)-1ππSHARED MinAbstand,Winkel0,Winkel1,Winkel2,Winkel4,Winkel5,Winkel6πSHARED Winkel15,Winkel30,Winkel45,Winkel60,Winkel90,Winkel135,Winkel180,Winkel225,Winkel270πSHARED Winkel315,Winkel360,WeltReihe,WeltSpalte,ZellXgroesse,ZellYgroesse,WeltXgroesse()πSHARED WeltYgroesse(),Welt(),tantable(),invtantable(),Ystep(),Xstep()πSHARED costable(),invcostable(),invsintable(),Sichtwinkel,Vptr,maxx,maxyππ' F U N C T I O N S *******************************************************'ππSUB Tabellenbauen()πDIM Winkl as integerπDIM radWinkel as extππFOR Winkl = Winkel0 to Winkel360π radWinkel = 3.272e-4 + Winkl * 3.27249234791667e-3π tantable(Winkl) = tan(radWinkel)π invtantable(Winkl) = 1/tantable(Winkl)ππ IF Winkl >= Winkel0 and Winkl < Winkel180 THENπ Ystep(Winkl) = abs(tantable(Winkl) * ZellYgroesse)π Elseπ Ystep(Winkl) =-abs(tantable(Winkl)* ZellYgroesse)π END IFππ IF Winkl >= Winkel90 and Winkl < Winkel270 THENπ Xstep(Winkl) =-abs(invtantable(Winkl) * ZellXgroesse)π Elseπ Xstep(Winkl) = abs(invtantable(Winkl) * ZellXgroesse)π END IFππ invcostable(Winkl) = 1/cos(radWinkel)π invsintable(Winkl) = 1/sin(radWinkel)ππNext WinklππFOR Winkl = -Winkel30 to Winkel30π radWinkel = 3.272e-4 + Winkl * 3.27249234791667e-3π costable(Winkl + Winkel30) = 1/cos(radWinkel)*10000πNext WinklππEND SUBππ'***************************************************************************'ππSUB LoadWelt(dateiname$)ππDIM index as integerπDIM row as integerπDIM column as integerπDIM buffer as StringπDIM ch as StringπOPEN Dateiname$ FOR input as #1πFOR Row = WeltReihe to 0 step -1π line input #1, bufferπ FOR column = 0 to WeltSpalteπ Welt(column,row) = Val(mid$(buffer,column+1,1))π Next columnπNext rowπClose #1πEND SUBππ'***************************************************************************'ππSUB RayCaster(x as long ,y as long)ππDIM Oben as singleπDIM Unten as singleπDIM Zellx as longπDIM Zelly as longπDIM Senke as longπDIM Waage as longπDIM ray as longπDIM xaufWaage as SingleπDIM yaufSenke as SingleπDIM distzuWaage as SingleπDIM distzuSenke as SingleπDIM Skalier as Singleππresett=SichtwinkelπSichtwinkel=Sichtwinkel-Winkel30πIF Sichtwinkel < 0 THEN Sichtwinkel=Winkel360 + SichtwinkelππtempWaage= int(y/ZellYgroesse) * ZellYgroesseπtempWaage1= int(y/ZellYgroesse) * ZellYgroesse+ZellYgroesseπtempSenke= int(x/ZellXgroesse) * ZellXgroesseπtempSenke1= int(x/ZellXgroesse) * ZellXgroesse + ZellXgroesseππdiffzuWaage=tempWaage-yπdiffzuSenke=tempSenke-xπdiffzuWaage1=tempWaage1-yπdiffzuSenke1=tempSenke1-xππFOR ray = 0 to 319ππ IF Sichtwinkel < Winkel180 THENπ Waage = tempWaage1π xaufWaage = invtantable(Sichtwinkel) * diffzuWaage1 + xπ NexteWaage=ZellYgroesseπ Nexty=0π elseπ Waage = tempWaageπ xaufWaage = invtantable(Sichtwinkel) * diffzuWaage + xπ NexteWaage=-ZellYgroesseπ Nexty=-1π END IFππ IF Sichtwinkel < Winkel90 or Sichtwinkel >= Winkel270 THENπ Senke = tempSenke1π yaufSenke = tantable(Sichtwinkel) * diffzuSenke1 + yπ NexteSenke=ZellXgroesseπ Nextx=0π elseπ Senke = tempSenkeπ yaufSenke = tantable(Sichtwinkel) * diffzuSenke + yπ NexteSenke=-ZellXgroesseπ Nextx=-1π END IFπππ WHILE 1ππ IF xaufWaage > maxx or xaufWaage < 0 THENπ distzuWaage = 1e+8π exit loopπ END IFππ Zellx = int(xaufWaage/ZellXgroesse)π Zelly = int(Waage/ZellYgroesse) + Nextyππ IF Welt(Zellx,Zelly) <> 0 THENπ distzuWaage=(xaufWaage-x)*invcostable(Sichtwinkel)π exit loopπ END IFππ xaufWaage = xaufWaage + Xstep(Sichtwinkel)π Waage = Waage + NexteWaageπ WENDπππ WHILE 2ππ IF yaufSenke > maxy or yaufSenke < 0 THENπ distzuSenke = 1e+8π exit loopπ END IFππ Zellx = int(Senke/ZellYgroesse) + Nextxπ Zelly = int(yaufSenke/ZellYgroesse)ππ IF Welt(Zellx,Zelly) <> 0 THENπ distzuSenke=(yaufSenke-y)* invsintable(Sichtwinkel)π exit loopπ END IFππ yaufSenke = yaufSenke + Ystep(Sichtwinkel)π Senke = Senke + NexteSenkeπ WENDπππ IF distzuWaage < distzuSenke THENππ Skalier = costable(ray) / distzuWaageπ Oben = 90 - Skalier/2π IF Oben < 20 THEN Oben = 20π Unten = 90 + Skalier/2π IF Unten > 180 THEN Unten=180ππ IF int(xaufWaage) MOD ZellYgroesse =< 1 THENπ colorr = 15π elseπ colorr=10π END IFπ Linie ray,20,ray,Oben ,160π Linie ray,Oben ,ray,Unten,colorrπ Linie ray,Unten,ray,180,215π elseπ Skalier = costable(ray) / distzuSenkeπ Oben = 90 - Skalier/2π IF Oben < 20 THEN Oben = 20π Unten = 90 + Skalier/2π IF Unten > 180 THEN Unten = 180π IF int(yaufSenke) MOD ZellXgroesse = < 1 THENπ colorr=15π elseπ colorr=2π END IFπ Linie ray,20,ray,Oben,160π Linie ray,Oben,ray,Unten,colorrπ Linie ray,Unten,ray,180,215π END IFπππ INCR Sichtwinkelπ IF Sichtwinkel >= Winkel360 THENπ Sichtwinkel=0π END IFπNext rayππSichtwinkel=resettπEND SUBππ' M A I N *****************************************************************'ππDIM x as longπDIM y as longπDIM xZell as longπDIM yZell as longπDIM xsubZell as longπDIM ysubZell as longππDIM dx as singleπDIM dy as singleππModus13πWriteScrn 1, 1, 11, "Raycasting Engine by Wolfgang Bruske"πWriteScrn 2, 1, 14, "SCREEN 13 Routines by Thomas Gohel"πWriteScrn 24, 1, 14, CHR$(24,25,26,27) + " oder 2, 4, 6, 8"ππCALL Tabellenbauen()πCALL LoadWelt("raycast.dat")πcolorr=15ππx=9*64+32πy=9*64+32πSichtwinkel=Winkel6ππCALL RayCaster(x,y)ππWHILE done = 0π kbhit=ascii(inkey$)π IF kbhit > 0 THENπ Taste$=chr$(kbhit)π kbhit = 0π dx=0π dy=0π select case Taste$ππ case "4"π DECR Sichtwinkel,Winkel6π IF Sichtwinkel < Winkel0 THEN Sichtwinkel=Winkel360+Sichtwinkelπ case "6"π INCR Sichtwinkel,Winkel6π IF Sichtwinkel > Winkel360 THEN Sichtwinkel =Sichtwinkel-Winkel360π case "8"π dx=cos(6.28*Sichtwinkel/Winkel360)*10π dy=sin(6.28*Sichtwinkel/Winkel360)*10π case "2"π dx=-cos(6.28*Sichtwinkel/Winkel360)*10π dy=-sin(6.28*Sichtwinkel/Winkel360)*10ππ case "q", CHR$(27)π Modus3π ENDπ end selectπ x=x+dxπ y=y+dyππ xZell = int(x/ZellXgroesse)π yZell = int(y/ZellYgroesse)π xsubZell = x MOD ZellXgroesseπ ysubZell = y MOD ZellYgroesseππ IF dx > 0 THENπ IF Welt(xZell+1,yZell) <> 0 and xsubZell > (ZellXgroesse-MinAbstand) THENπ x = x -(xsubZell-(ZellXgroesse-MinAbstand))π END IFπ elseπ IF Welt(xZell-1,yZell) <> 0 and xsubZell < MinAbstand THENπ x = x + (MinAbstand-xsubZell)π END IFπ END IFππ IF dy > 0 THENπ IF Welt(xZell,(yZell+1)) <> 0 and ysubZell > (ZellYgroesse-MinAbstand ) THENπ y = y -(ysubZell-(ZellYgroesse-MinAbstand ))π END IFπ elseπ IF Welt(xZell,(yZell-1)) <> 0 and ysubZell < MinAbstand THENπ y = y + (MinAbstand-ysubZell)π END IFπ END IFπ CALL RayCaster(x,y)π END IFπWENDππSUB Modus13π ! mov al, &h13π ! mov ah, 0π ! int &h10πEND SUBππSUB Modus3π ! mov al, &h03π ! mov ah, 0π ! int &h10πEND SUBππSUB Linie(BYVAL x1%, BYVAL y1%, BYVAL x2%, BYVAL y2%, BYVAL Farbe%) publicπ LOCAL s1%, s2%, s3%, s4%π ! push esπ ! push diπ ! mov ax, &ha000 ;' nur einmal VideoSegment setzenπ ! mov es, axπ ! mov ax, x2% ;' Differenz x2% - x1% nach axπ ! sub ax, x1%π ! jns Linie1π ! neg ax ; VorzeichentauschπLinie1:π ! mov bx, y2% ; Differenz von y2% - y1% nach bxπ ! sub bx, y1%π ! jns Linie2π ! neg bx ; VorzeichentauschπLinie2:π ! cmp ax, bx ; Steigung <= 1 ?π ! jge Linie3A ; Jaπ ! jmp Linie20 ; NeinπLinie3A:π ! mov cx, x1% ; Ist x1% <= x2% ?π ! cmp cx, x2%π ! jg Linie4π ! mov cx, 1 ; X steigtπ ! jmp Linie5πLinie4:π ! mov cx, -1 ; X fΣlltπLinie5:π ! mov dx, y1% ; ist y1% <= y2%π ! cmp dx, y2%π ! jg Linie6π ! mov dx, 1 ; Y steigtπ ! jmp Linie7πLinie6:π ! mov dx, -1 ; Y fΣlltπLinie7:π ! mov s1%, cx ; Steigung auf dem Stack speichernπ ! mov s2%, dxπ ! add bx, bx ; Steigung berechnenπ ! mov s3%, bxπ ! sub bx, axπ ! mov cx, bxπ ! sub cx, axπ ! mov s4%, cxπ ! mov cx, x1%π ! mov dx, y1%π ! call SetPunktπLinie8:π ! cmp cx, x2% ; Weitere Punkte?π ! jz Linie3π ! add cx, s1% ; X-Koordinate erh÷henπ ! or bx, bx ; Entscheiden, ob Y-Koordinate erh÷htπ ! jns Linie10 ; wirdπ ! add bx, s3%π ! jmp Linie11πLinie10:π ! add bx, s4% ; NΣchsten Punkt ausgebenπ ! add dx, s2%πLinie11:π ! call Setpunktπ ! jmp Linie8πLinie20:ππ';----------------------------------------------------------π'; Dieser Teil wird durchlaufen, wenn die Steigung > 1 istπ';----------------------------------------------------------ππ ! mov cx, y1% ; Steigung ist > 1π ! cmp cx, y2% ; Ist y1% <= y2% ?π ! jg Linie12π ! mov cx,1 ; Y steigtπ ! jmp Linie13πLinie12:π ! mov cx, -1 ; Y fΣlltπLinie13:π ! mov dx, x1% ; ist x1% <= x2% ?π ! cmp dx, x2%π ! jg Linie14π ! mov dx, 1 ; X steigtπ ! jmp Linie15πLinie14:π ! mov dx, -1 ; X fΣlltπLinie15:π ! mov s1%, cx ; Steigung auf dem Stack speichernπ ! mov s2%, dxπ ! add ax, ax ; Steigung berechnenπ ! mov s3%, axπ ! sub ax, bxπ ! mov cx, axπ ! sub cx, bxπ ! mov s4%, cxπ ! mov bx, axπ ! mov cx, x1%π ! mov dx, y1%π ! call SetPunktπLinie16:π ! cmp dx, y2% ; Weitere Punkte ausgeben?π ! jz Linie3π ! add dx, s1%π ! or bx, bxπ ! jns Linie18π ! add bx, s3%π ! jmp Linie19πLinie18:π ! add bx, s4%π ! add cx, s2%πLinie19:π ! call SetPunktπ ! jmp Linie16πLinie3:π ! jmp EndeπSetPunkt:π ! mov di, dxπ ! push bxπ ! mov bx, dxπ ! mov ax, 320π ! mul bxπ ! mov bx, cxπ ! add bx, axπ ! mov al, Farbe%π ! mov es:[bx], alπ ! pop bxπ ! mov dx, diπ ! retnπEnde:π ! pop diπ ! pop esπEND SUBππSUB WriteScrn (BYVAL Zeile?, BYVAL Spalte?, BYVAL Farbe%, BYVAL Text$)π ' PowerBASIC 3.0 kompatibel, Shit Err244 Bug :-(π LOCAL TextSeg??, TextOff??, TextLen??π TextSeg?? = STRSEG(Text$)π TextOff?? = STRPTR(Text$)π TextLen?? = LEN(Text$)π ! push bpπ ! dec Zeile?π ! dec Spalte?π ! mov ax, &h1301π ! mov bl, Farbe%π ! mov bh, 0π ! mov cx, TextLen??π ! mov dh, Zeile?π ! mov dl, Spalte?π ! mov es, TextSeg??π ! mov bp, TextOff??π ! int &h10π ! pop bpπEND SUBπ--- Cut End -------------------------------------------------------------ππDAT-file:ππ--- Cut ----------------------------------------------------------------πsection 1 of uuencode 5.20 of file raycast.dat by R.E.M.ππbegin 644 raycast.datπM,3$Q,3$Q,3$Q,3$Q,3$Q,0T*,2`@("`@("`@("`@("`@,0T*,2`Q(#$@,2`QπM(#$@,2`Q,0T*,2`@("`@("`@("`@("`@,0T*,3$Q(#$Q,3$Q,3$Q("`@,0T*πM,2`@("`@,2`@("`Q("`@,0T*,2`@("`@,2`@("`Q("`@,0T*,3$Q,3$Q,2`@πM("`Q("`@,0T*,2`@("`@,3$Q(#$Q("`@,0T*,2`@("`@("`@("`Q("`@,0T*πM,2`@("`@("`@("`Q("`@,0T*,2`Q,3$Q,3$Q,3$Q,3$@,0T*,2`Q("`@("`@πM("`@("`@,0T*,2`Q("`@("`@(#$@("`@,0T*,2`@("`@("`@(#$@("`@,0T*πH,3$Q,3$Q,3$Q,3$Q,3$Q,0T*#0H-"@T*#0H-"@T*#0H-"@T*#0H-"@H-π`πendπsum -r/size 2742/458 section (from "begin" to "end")πsum -r/size 47403/310 entire input fileπ--- Cut End -------------------------------------------------------------πAndrew L. Ayers BURNING TEXT andrewa@indirect.com 07-24-96 (00:00) QB, QBasic, PDS 59 1675 FIREPRN.BAS ' Description : FirePrint! - Custom text print subroutine forπ' VGA Mode 13π' Written by : Andrew L. Ayersπ' Date : 07/24/96π'π' This little routine allows you to place a "burning" textπ' string on the mode 13 screen. This routine was based onπ' a routine by Martin Lindhe. Both are essentially the same,π' though this one is cleaner. Remember, the better the machine,π' the better the effect. Also, smaller strings will look better.π'π' You may use this routine in any manner you like, as longπ' as you give Mr. Lindhe and myself credit in an appropriateπ' manner.π'π' I wish to thank Martin Lindhe for providing the inspirationπ' to do this routine.π'πDECLARE SUB FirePrint (h%, v%, a$, tilt%)π'πSCREEN 13π'π' Set up an all "red" paletteπ'πFOR t = 0 TO 63: PALETTE t, t: NEXT tπ'π' Call the routine once for a simple "flame" effect,π' or over and over (as done here) for a great "burning"π' effect! Use uppercase for best effect.π'πDOπ CALL FirePrint(18, 12, "FIRE!", 0)πLOOP UNTIL INKEY$ <> ""ππSUB FirePrint (h%, v%, a$, tilt%)π 'π ' Print the string in bright "red"π 'π COLOR 63: LOCATE v%, h%: PRINT a$π 'π ' Set up start and end locations for the burnπ 'π sx% = (h% * 8) - 8: ex% = ((h% + LEN(a$)) * 8) - 8π sy% = (v% * 8) - 16: ey% = (v% * 8) - 8π 'π FOR y% = sy% TO ey%π FOR x% = sx% TO ex%π 'π ' Take the current color, subtract a random amount forπ ' red flame "fade", and plot the new pointπ 'π col% = POINT(x%, y%) - RND * 25: IF col% < 0 THEN col% = 0π 'π PSET (x% + tilt%, y% - 1), col%π 'π NEXT x%π NEXT y%π 'πEND SUBπAndrew L. Ayers STEEL PRINT andrewa@indirect.com 08-01-96 (00:00) QB, QBasic, PDS 39 1022 STEELPRN.BAS' Description : SteelPrint! - Custom text print subroutine forπ' VGA Mode 13π' Written by : Andrew L. Ayersπ' Date : 08/01/96π'π' This little routine allows you to place a "steel-like" textπ' string on the mode 13 screen.π'π' You may use this routine in any manner you like, as longπ' as you give credit in an appropriate manner.π'πDECLARE SUB SteelPrint (x%, y%, text$)π'πSCREEN 13π'πCALL SteelPrint(5, 12, "SteelPrint! by Andrew L. Ayers")π'πDO: LOOP UNTIL INKEY$ <> ""ππSUB SteelPrint (x%, y%, text$)π 'π starty% = (y% * 8) - 4π endy% = (y% * 8) - 9π startx% = ((x% - 1) * 8)π endx% = ((x% - 1) * 8) + (LEN(text$) * 8)π colr% = 32π 'π COLOR 15: LOCATE y%, x%: PRINT text$π 'π FOR y1% = starty% TO endy% STEP -1π y2% = (starty% - 1) + ((starty% - 1) - y1%)π FOR x% = startx% TO endx%π IF POINT(x%, y1%) THEN PSET (x%, y1%), colr%π IF POINT(x%, y2%) THEN PSET (x%, y2%), colr%π NEXT x%π colr% = colr% - 2π NEXT y1%π 'πEND SUBπAndrew L. Ayers PSYCHO PRINT andrewa@indirect.com 08-13-96 (00:00) QB, QBasic, PDS 120 3497 PSYCHO.BAS ' Description : PsychoPrint! - Custom text print subroutine forπ' VGA Mode 13π' Written by : Andrew L. Ayersπ' Date : 08/13/96π'π' What can I say? I can't seem to get enough of custom text!π' Well, anyhow - this routine needs to be played with. It allowsπ' you to create text that flashes (techno/house/rave style),π' text that fades away, dot by dot, and random snow text (certainπ' combos of which look like flowing puke), and even rainbow flashπ' text. Give it a shot!π'π' BTW: You may use this routine in any manner you like, as longπ' as you give credit in an appropriate manner.π'πDECLARE SUB PsychoPrint (x%, y%, strg$, fclr%, bclr%, range1%, range2%, factor%, special%)π'πSCREEN 13π'πDOπ 'π special% = 1π 'π CALL PsychoPrint(6, 12, "PsychoPrint! by Andrew Ayers", 3, 0, 0, 15, 4, special%)π 'πLOOP UNTIL special% = 999 OR INKEY$ <> ""ππSUB PsychoPrint (x%, y%, strg$, fclr%, bclr%, range1%, range2%, factor%, special%)π 'π STATIC FirstTime AS INTEGERπ STATIC colr AS INTEGERπ 'π IF strg$ = "" THEN FirstTime% = 0: EXIT SUBπ 'π xpos% = x% * 8 - 8: ypos% = y% * 8 - 8π xend% = xpos% + (LEN(strg$) * 8): yend% = ypos% + 8π 'π IF FirstTime% = 0 THENπ COLOR 255: LOCATE y%, x%: PRINT strg$: FirstTime% = 1π COLOR 15π colr% = fclr%π FOR y% = ypos% TO yend%π FOR x% = xpos% TO xend%π IF POINT(x%, y%) <> 255 THENπ PSET (x%, y%), bclr%π ELSEπ PSET (x%, y%), fclr%π END IFπ NEXT x%π NEXT y%π END IFπ 'π '***********************************************************π 'π flag% = 999π 'π FOR y% = ypos% TO yend%π FOR x% = xpos% TO xend%π IF POINT(x%, y%) <> bclr% THENπ flag% = 0π PSET (x%, y%), colr%π 'π SELECT CASE special%π CASE 3 ' Regular Fadeπ IF INT(RND * 2) = 1 THENπ colr% = bclr%π ELSEπ colr% = fclr%π END IFπ CASE 4 ' Psycho Snowπ colr% = INT(RND * factor%)π IF colr% = bclr% THEN colr% = colr% + 1π CASE 5 ' Psycho Snow Fadeπ colr% = INT(RND * factor%)π END SELECTπ 'π END IFπ 'π SELECT CASE special%π CASE 1 ' Psycho Cycleπ colr% = colr% + factor%π IF colr% = bclr% THEN colr% = colr% + 1π IF colr% >= range2% THEN colr% = range1%π IF colr% = bclr% THEN colr% = colr% + 1π CASE 2 ' Psycho Fadeπ colr% = colr% + 1π IF colr% > range2% THEN colr% = range1%π END SELECTπ 'π NEXT x%π 'π SELECT CASE special%π CASE 6 ' Psycho Rainbowπ colr% = colr% + factor%π IF colr% = bclr% THEN colr% = colr% + 1π IF colr% >= range2% THEN colr% = range1%π IF colr% = bclr% THEN colr% = colr% + 1π CASE 7 ' Psycho Rainbow Fadeπ colr% = colr% + 1π IF colr% > range2% THEN colr% = range1%π CASE 8 ' Regular Line Fadeπ IF INT(RND * 2) = 1 THENπ colr% = bclr%π ELSEπ colr% = fclr%π END IFπ CASE 9 ' Psycho Line Snowπ colr% = INT(RND * factor%)π IF colr% = bclr% THEN colr% = colr% + 1π CASE 10 ' Psycho Line Snow Fadeπ colr% = INT(RND * factor%)π END SELECTπ 'π NEXT y%π 'π FOR dlay = 1 TO 10000: NEXT dlay' Adjust this to your computerπ 'π special% = flag%π 'πEND SUBπAndrew L. Ayers FAST VGA SCROLL andrewa@indirect.com 08-02-96 (00:00) QB, QBasic, PDS 88 3093 FASTSCRL.BAS' Description : FastScroll! - VGA Mode 13 Scrolling Routineπ' Written by : Andrew L. Ayersπ' Date : 08/02/96π'π' This little routine allows you to scroll the ENTIRE mode 13π' screen ANY number of pixels up, down, left and right. It usesπ' GET/PUT to accomplish this, but the GET/PUT is tiled aroundπ' the screen, so that the buffer used only needs to be aboutπ' 1000 bytes! When you use this routine, don't pass in bothπ' x and y offsets at one time (don't try to go diagonal) - theπ' program will bomb. Pass one, then the other to move diagonally.π' I know this isn't the best way (jumps a bit), but it does work.π' I made this routine for a game, and I only needed the fourπ' cardinal directions. When scrolling, be aware of the fact thatπ' if any graphics are on the edges of the scroll region (one pixelπ' "in" if offset is 1, two if offset is 2, 4 if offset is four,π' etc.), when the scroll is performed, "droppings" will be leftπ' and will need to be cleaned up. I know I could have did thisπ' myself, but I felt that some people may have wanted droppingsπ' left (I don't know why...), so I left it like it is.π'π' You may use this routine in any manner you like, as longπ' as you give credit in an appropriate manner. Have phun!π'πDECLARE SUB FastScroll (XSpeed%, YSpeed%)π'πSCREEN 13π'π' Set up a Demo Graphicπ'πFOR T% = 0 TO 500π X1% = INT(RND * 260) + 10π Y1% = INT(RND * 140) + 10π X2% = INT(RND * 260) + 10π Y2% = INT(RND * 140) + 10π C% = INT(RND * 16)π LINE (X1%, Y1%)-(X2%, Y2%), C%πNEXT T%π'πLOCATE 11, 4: PRINT "FastScroll! by Andrew L. Ayers"π'π' Show off scrolling!π'πcount% = 0: x% = 1: y% = 0π'πDOπ count% = count% + 1π IF count% = 10 THEN x% = 0: y% = 1π IF count% = 20 THEN x% = -1: y% = 0π IF count% = 30 THEN x% = 0: y% = -1π IF count% = 40 THEN x% = 1: y% = 0: count% = 0π 'π CALL FastScroll(x% * 4, y% * 4)πLOOP UNTIL INKEY$ <> ""ππSUB FastScroll (XSpeed%, YSpeed%)π 'π DIM Temp%(502)π 'π XStep% = 40: YStep% = 25π 'π IF XSpeed% < 0 OR YSpeed% < 0 THENπ FOR y% = 0 TO 199 STEP YStep%π FOR x% = 0 TO 319 STEP XStep%π IF (XSpeed% <> 0 AND x% = 0) OR (YSpeed% <> 0 AND y% = 0) THENπ GET (x% - XSpeed%, y% - YSpeed%)-(x% + XStep% - 1, y% + YStep% - 1), Temp%π PUT (x%, y%), Temp%, PSETπ ELSEπ GET (x%, y%)-(x% + XStep% - 1, y% + YStep% - 1), Temp%π PUT (x% + XSpeed%, y% + YSpeed%), Temp%, PSETπ END IFπ NEXT x%π NEXT y%π ELSEπ FOR y% = 199 TO 0 STEP -YStep%π FOR x% = 319 TO 0 STEP -XStep%π IF (XSpeed% <> 0 AND x% = 319) OR (YSpeed% <> 0 AND y% = 199) THENπ GET (x% - (XStep% - 1), y% - (YStep% - 1))-(x% - XSpeed%, y% - YSpeed%), Temp%π PUT (x% - (XStep% - 1) + XSpeed%, y% - (YStep% - 1) + YSpeed%), Temp%, PSETπ ELSEπ GET (x% - (XStep% - 1), y% - (YStep% - 1))-(x%, y%), Temp%π PUT (x% - (XStep% - 1) + XSpeed%, y% - (YStep% - 1) + YSpeed%), Temp%, PSETπ END IFπ NEXT x%π NEXT y%π END IFπ 'πEND SUBπAndrew L. Ayers BIG TEXT SCROLL andrewa@indirect.com 08-15-96 (00:00) QB, QBasic, PDS 123 3346 BIGSCROL.BAS' Description : BigScroll! - Another VGA Mode 13 Scrolling Routineπ' Written by : Andrew L. Ayersπ' Date : 08/15/96π'π' This uses my FastScroll! routine, as well as another routineπ' to do a LARGE text scroller. Check it out!π'π' You may use this routine in any manner you like, as longπ' as you give credit in an appropriate manner. Have phun!π'πDECLARE SUB FastScroll (XSpeed%, YSpeed%)π'πDEFINT A-Zπ'πDIM a1(32 * 64 * 11), a2(32 * 64 * 11), a3(32 * 64 * 11)π'πSCREEN 13π'πCOLOR 7: LOCATE 10, 6: PRINT "Please wait...Building font": COLOR 0π'πFOR T = 15 TO 255: PALETTE T, 0: NEXT Tπ'πA$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ!?.-"π'πFOR T = 0 TO 30π GOSUB DrawLetterπ GOSUB GetLetterπNEXT Tπ'πSCREEN 0: CLS 0: SCREEN 13π'πB$ = "BIG SCROLL! BY ANDREW AYERS - HOW DO YOU LIKE IT?... "π'πDOπ FOR TT = 1 TO LEN(B$)π T = INSTR(A$, MID$(B$, TT, 1)) - 1π GOSUB PutLetterπ FOR X = 0 TO 7π CALL FastScroll(-8, 0)π LINE (311, 0)-(319, 199), 0, BFπ NEXT Xπ NEXT TTπLOOP UNTIL UCASE$(INKEY$) = "Q"π'πSTOPπ'πDrawLetter:π 'π LINE (0, 0)-(8, 8), 0, BFπ LINE (0, 100)-(319, 199), 0, BFπ 'π COLOR 255: LOCATE 1, 1: PRINT MID$(A$, T + 1, 1)π 'π SCALE = 8π 'π FOR y = 0 TO (SCALE - 1)π FOR X = 1 TO 1 * SCALEπ IF POINT(X - 1, y) = 255 THENπ LINE (X * SCALE, 100 + y * SCALE)-(X * SCALE + SCALE, 100 + y * SCALE + SCALE), 15, BFπ END IFπ NEXT Xπ NEXT yπ 'π FOR y = 0 TO SCALE * SCALEπ C = (16 * ABS(y < 31)) + INT(y / 2)π FOR X = 0 TO SCALE * SCALEπ IF POINT(X, 100 + y) THENπ PSET (X, 100 + y), Cπ END IFπ NEXT Xπ NEXT yπ 'π RETURNππGetLetter:π 'π IF T >= 0 AND T < 10 THEN GET (0, 100)-(64, 160), a1(T * 32 * 64)π IF T >= 10 AND T < 20 THEN GET (0, 100)-(64, 160), a2((T - 10) * 32 * 64)π IF T >= 20 AND T < 30 THEN GET (0, 100)-(64, 160), a3((T - 20) * 32 * 64)π 'π RETURNππPutLetter:π 'π IF T >= 0 AND T < 10 THEN PUT (255, 68), a1(T * 32 * 64), PSETπ IF T >= 10 AND T < 20 THEN PUT (255, 68), a2((T - 10) * 32 * 64), PSETπ IF T >= 20 AND T < 30 THEN PUT (255, 68), a3((T - 20) * 32 * 64), PSETπ 'π RETURNππSUB FastScroll (XSpeed%, YSpeed%)π 'π DIM Temp%(502)π 'π XStep% = 40: YStep% = 25π 'π IF XSpeed% < 0 OR YSpeed% < 0 THENπ FOR y% = 0 TO 199 STEP YStep%π FOR X% = 0 TO 319 STEP XStep%π IF (XSpeed% <> 0 AND X% = 0) OR (YSpeed% <> 0 AND y% = 0) THENπ GET (X% - XSpeed%, y% - YSpeed%)-(X% + XStep% - 1, y% + YStep% - 1), Temp%π PUT (X%, y%), Temp%, PSETπ ELSEπ GET (X%, y%)-(X% + XStep% - 1, y% + YStep% - 1), Temp%π PUT (X% + XSpeed%, y% + YSpeed%), Temp%, PSETπ END IFπ NEXT X%π NEXT y%π ELSEπ FOR y% = 199 TO 0 STEP -YStep%π FOR X% = 319 TO 0 STEP -XStep%π IF (XSpeed% <> 0 AND X% = 319) OR (YSpeed% <> 0 AND y% = 199) THENπ GET (X% - (XStep% - 1), y% - (YStep% - 1))-(X% - XSpeed%, y% - YSpeed%), Temp%π PUT (X% - (XStep% - 1) + XSpeed%, y% - (YStep% - 1) + YSpeed%), Temp%, PSETπ ELSEπ GET (X% - (XStep% - 1), y% - (YStep% - 1))-(X%, y%), Temp%π PUT (X% - (XStep% - 1) + XSpeed%, y% - (YStep% - 1) + YSpeed%), Temp%, PSETπ END IFπ NEXT X%π NEXT y%π END IFπ 'πEND SUBπAndrew L. Ayers VGA PALETTE READ/WRITE ROUTINESandrewa@indirect.com 07-24-96 (00:00) QB, QBasic, PDS 129 3662 VGAPAL.BAS ' Description : Mode 13 VGA Palette Read/Write Subroutinesπ' and custom palette setting routineπ' Written by : Andrew L. Ayersπ' Date : 07/24/96π'π' These read/write routines were developed from informationπ' provided by Eli Bennett in an ABC Code Packet. The paletteπ' setting (spreading?) routine is my own. These routines shouldπ' make it easier to read/write RGB values to the VGA palette inπ' mode 13 as well as in setting up palettes. If you use theseπ' routines, please give credit to both Mr. Bennett and myself.π' Have phun!π'πDECLARE SUB ReadRGB (red%, grn%, blu%, slot%)πDECLARE SUB WriteRGB (red%, grn%, blu%, slot%)πDECLARE SUB SetPal (start.slot%, end.slot%)π'πDIM oldr%(255), oldg%(255), oldb%(255)π'πSCREEN 13π'π' Save old paletteπ'πFOR t% = 0 TO 255π CALL ReadRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)πNEXT t%π'π' Create a custom 256 color paletteπ'πCALL WriteRGB(63, 63, 63, 1) ' From all whiteπCALL WriteRGB(63, 0, 0, 63) ' to red, and thenπCALL WriteRGB(0, 63, 0, 127) ' to green, thenπCALL WriteRGB(0, 0, 63, 191) ' to blue, and finallyπCALL WriteRGB(63, 63, 63, 255) ' back to white...π'πCALL SetPal(1, 63) ' Each of these linesπCALL SetPal(63, 127) ' create a portion ofπCALL SetPal(127, 191) ' the color spread. TheπCALL SetPal(191, 255) ' two arguments are theπ ' start and ending slotsπ ' for the spread...π'π' Display exampleπ'πFOR t% = 1 TO 255π LINE (t% - 1, 0)-(t% - 1, 199), t%πNEXT t%ππ'π' Rotate palette - this isn't how you would do itπ' for speed (for more speed, inline the read/write codeπ' to eliminate subroutine calling overhead), but itπ' does show how to do it. Notice the "sparklies" alongπ' the right hand edge. These are only apparent if yourπ' computer is fast enough. I believe this has to do withπ' the registers being updated faster than the video cardπ' can keep up with or sothing like that. If anyone knowsπ' how to fix this, go for it!π'πDOπ 'π CALL ReadRGB(ored%, ogrn%, oblu%, 1) ' Read in slot 1.π 'π FOR t% = 1 TO 254π CALL ReadRGB(red%, grn%, blu%, t% + 1) ' Read slots 2-255, thenπ CALL WriteRGB(red%, grn%, blu%, t%) ' shift to slots 1-254.π NEXT t%π 'π CALL WriteRGB(ored%, ogrn%, oblu%, 255) ' Write what was in slot 1 toπ ' slot 255.πLOOP UNTIL INKEY$ <> ""π'πCLSππ'π' Reset original RGB valuesπ'πFOR t% = 0 TO 255π CALL WriteRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)πNEXT t%ππSUB ReadRGB (red%, grn%, blu%, slot%)π 'π OUT &H3C7, slot% ' Read RGB values from slotπ 'π red% = INP(&H3C9)π grn% = INP(&H3C9)π blu% = INP(&H3C9)π 'πEND SUBππSUB SetPal (start.slot%, end.slot%)π 'π num.slots% = end.slot% - start.slot%π 'π CALL ReadRGB(sr%, sg%, sb%, start.slot%)π CALL ReadRGB(er%, eg%, eb%, end.slot%)π 'π rr% = ABS(er% - sr%): rg% = ABS(eg% - sg%): rb% = ABS(eb% - sb%)π rs% = SGN(er% - sr%): gs% = SGN(eg% - sg%): bs% = SGN(eb% - sb%)π 'π stepr = (rr% / num.slots%) * rs%π stepg = (rg% / num.slots%) * gs%π stepb = (rb% / num.slots%) * bs%π 'π r = sr%: g = sg%: b = sb%π wr% = r: wg% = g: wb% = bπ 'π FOR t% = start.slot% TO end.slot%π 'π CALL WriteRGB(wr%, wg%, wb%, t%)π 'π r = r + stepr: wr% = rπ g = g + stepg: wg% = gπ b = b + stepb: wb% = bπ 'π NEXT t%π 'πEND SUBππSUB WriteRGB (red%, grn%, blu%, slot%)π 'π OUT &H3C8, slot% ' Write RGB values to slotπ 'π OUT &H3C9, red%π OUT &H3C9, grn%π OUT &H3C9, blu%π 'πEND SUBπAndrew L. Ayers VGA SINUSOIDAL PLASMA andrewa@indirect.com 07-24-96 (00:00) QB, QBasic, PDS 175 4887 PLASMA.BAS ' Description : Mode 13 VGA Sinusoidal Plasma!π' Written by : Andrew L. Ayersπ' Date : 07/24/96π'π' Now here's one for the masses! This creates sinusoidal plasma, whichπ' tends to be way easier to create than cloud plasma. This routine isn'tπ' optimized too much (a SIN table would speed it up some). Play with itπ' some. As always, if you use the routine in your own program or demo,π' please mention my name. Thanks, and have phun!ππDECLARE SUB SetPal (start.slot%, end.slot%)πDECLARE SUB ReadRGB (red%, grn%, blu%, slot%)πDECLARE SUB WriteRGB (red%, grn%, blu%, slot%)π'πDIM oldr%(255), oldg%(255), oldb%(255), A%(300), C%(300)π'πSCREEN 13π'π' Save old palette, set palette to black toπ' hide the build process...π'πFOR t% = 0 TO 255π CALL ReadRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)π CALL WriteRGB(0, 0, 0, t%)πNEXT t%π'π' TPI = 2 x PI - Do NOT mess with, needed for SIN Calcsπ' FREQ = Frequency (Duh!) - Go ahead and mess with these two...π' AMPLITUDE = (Double Duh!)π'πTPI = 6.28318: FREQ% = 4: AMPLITUDE% = 15π'π' Create Sinusoidal Multicolored Backdrop Thingy!π'πSCALE = (TPI * FREQ%) / 320π'πFOR Y% = 0 TO 199π RAD = 0π COLR% = COLR% + 1: IF COLR% > 255 THEN COLR% = 1π LINE (0, Y%)-(0, Y%), COLR%π FOR X% = 0 TO 319 STEP 8π YPOS% = Y% + SIN(RAD) * AMPLITUDE%π LINE -(X%, YPOS%), COLR%π RAD = RAD + (SCALE * 6)π NEXT X%πNEXT Y%π'π' Warp it sinusoidally in a horizontal fashion!π'πRAD = 0πFREQ% = 8: AMPLITUDE% = 15πSCALE = (TPI * FREQ%) / 200π'πFOR Y% = 0 TO 199π XPOS% = INT(SIN(RAD) * AMPLITUDE%)π GET (0, Y%)-(319 - XPOS%, Y%), A%π IF XPOS% >= 0 THENπ GET (319 - XPOS%, Y%)-(319, Y%), C%π PUT (XPOS%, Y%), A%, PSETπ PUT (0, Y%), C%, PSETπ ELSEπ GET (ABS(XPOS%), Y%)-(319, Y%), A%π GET (0, Y%)-(ABS(XPOS%), Y%), C%π PUT (0, Y%), A%, PSETπ PUT (319 + XPOS%, Y%), C%, PSETπ END IFπ RAD = RAD + SCALEπNEXT Y%π'π' Mask off ugly portionsπ'πLINE (0, 0)-(319, 17), 0, BFπLINE (0, 174)-(319, 199), 0, BFπLINE (0, 0)-(35, 199), 0, BFπLINE (289, 0)-(319, 199), 0, BFπ'πLOCATE 2, 9: PRINT "Sinusoidal Plasma Effect!"πLOCATE 23, 12: PRINT "By Andrew L. Ayers"π'π' Create a custom 256 color paletteπ'πCALL WriteRGB(63, 63, 63, 1) ' From all whiteπCALL WriteRGB(63, 0, 0, 63) ' to red, and thenπCALL WriteRGB(0, 63, 0, 127) ' to green, thenπCALL WriteRGB(0, 0, 63, 191) ' to blue, and finallyπCALL WriteRGB(63, 63, 63, 255) ' back to white...π'πCALL SetPal(1, 63) ' Each of these linesπCALL SetPal(63, 127) ' create a portion ofπCALL SetPal(127, 191) ' the color spread. TheπCALL SetPal(191, 255) ' two arguments are theπ ' start and ending slotsπ ' for the spread...ππ'π' Rotate palette - this isn't how you would do itπ' for speed (for more speed, inline the read/write codeπ' to eliminate subroutine calling overhead), but itπ' does show how to do it. Notice the "sparklies" alongπ' the right hand edge. These are only apparent if yourπ' computer is fast enough. I believe this has to do withπ' the registers being updated faster than the video cardπ' can keep up with or sothing like that. If anyone knowsπ' how to fix this, go for it!π'πDOπ 'π CALL ReadRGB(ored%, ogrn%, oblu%, 1) ' Read in slot 1.π 'π FOR t% = 1 TO 254π CALL ReadRGB(red%, grn%, blu%, t% + 1) ' Read slots 2-255, thenπ CALL WriteRGB(red%, grn%, blu%, t%) ' shift to slots 1-254.π NEXT t%π 'π CALL WriteRGB(ored%, ogrn%, oblu%, 255) ' Write what was in slot 1 toπ ' slot 255.πLOOP UNTIL INKEY$ <> ""π'πCLSππ'π' Reset original RGB valuesπ'πFOR t% = 0 TO 255π CALL WriteRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)πNEXT t%ππSUB ReadRGB (red%, grn%, blu%, slot%)π 'π OUT &H3C7, slot% ' Read RGB values from slotπ 'π red% = INP(&H3C9)π grn% = INP(&H3C9)π blu% = INP(&H3C9)π 'πEND SUBππSUB SetPal (start.slot%, end.slot%)π 'π num.slots% = end.slot% - start.slot%π 'π CALL ReadRGB(sr%, sg%, sb%, start.slot%)π CALL ReadRGB(er%, eg%, eb%, end.slot%)π 'π rr% = ABS(er% - sr%): rg% = ABS(eg% - sg%): rb% = ABS(eb% - sb%)π rs% = SGN(er% - sr%): gs% = SGN(eg% - sg%): bs% = SGN(eb% - sb%)π 'π stepr = (rr% / num.slots%) * rs%π stepg = (rg% / num.slots%) * gs%π stepb = (rb% / num.slots%) * bs%π 'π r = sr%: g = sg%: b = sb%π wr% = r: wg% = g: wb% = bπ 'π FOR t% = start.slot% TO end.slot%π 'π CALL WriteRGB(wr%, wg%, wb%, t%)π 'π r = r + stepr: wr% = rπ g = g + stepg: wg% = gπ b = b + stepb: wb% = bπ 'π NEXT t%π 'πEND SUBππSUB WriteRGB (red%, grn%, blu%, slot%)π 'π OUT &H3C8, slot% ' Write RGB values to slotπ 'π OUT &H3C9, red%π OUT &H3C9, grn%π OUT &H3C9, blu%π 'πEND SUBπAndrew L. Ayers CLOUD PLASMA EFFECT andrewa@indirect.com 07-24-96 (00:00) QB, QBasic, PDS 222 6227 CLOUD.BAS ' Description : Mode 13 VGA Cloud Plasma!π' Written by : Andrew L. Ayersπ' Date : 07/24/96π'π' Now here's yet another for the masses! This creates cload plasma, whichπ' is also known as fractal plasma. This routine is pretty damn fastπ' already, but if you can speed it up, go for it! Play with it some.π' As always, if you use the routine in your own program or demo, pleaseπ' mention my name. Thanks, and have phun!ππDECLARE SUB SetPal (start.slot%, end.slot%)πDECLARE SUB ReadRGB (red%, grn%, blu%, slot%)πDECLARE SUB WriteRGB (red%, grn%, blu%, slot%)πDECLARE SUB PLASMA (XE%, YE%, SCALE%)πDECLARE SUB DRAW.PLASMA (XS%, YS%, XE%, YE%, REDRAW%, SCALE%)π'πDIM oldr%(255), oldg%(255), oldb%(255)π'πSCREEN 13π'π' Save old palette, change to black toπ' hide build processπ'πFOR t% = 0 TO 255π CALL ReadRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)π CALL WriteRGB(0, 0, 0, t%)πNEXT t%ππ'πRANDOMIZE TIMERπ'πCALL PLASMA(512, 256, 4)ππLOCATE 2, 11: PRINT "Cloud Plasma Effect!"πLOCATE 23, 12: PRINT "By Andrew L. Ayers"ππ'π' Create a custom 256 color paletteπ'πCALL WriteRGB(0, 0, 0, 1)πCALL WriteRGB(63, 63, 0, 31)πCALL WriteRGB(0, 0, 63, 63)πCALL WriteRGB(0, 63, 63, 95)πCALL WriteRGB(63, 0, 0, 127)πCALL WriteRGB(0, 63, 0, 159)πCALL WriteRGB(63, 0, 63, 191)πCALL WriteRGB(63, 63, 63, 223)πCALL WriteRGB(0, 0, 0, 255)π'πCALL SetPal(1, 31)πCALL SetPal(31, 63)πCALL SetPal(63, 95)πCALL SetPal(95, 127)πCALL SetPal(127, 159)πCALL SetPal(159, 191)πCALL SetPal(191, 223)πCALL SetPal(223, 255)ππ'π' Rotate palette - this isn't how you would do itπ' for speed (for more speed, inline the read/write codeπ' to eliminate subroutine calling overhead), but itπ' does show how to do it. Notice the "sparklies" alongπ' the right hand edge. These are only apparent if yourπ' computer is fast enough. I believe this has to do withπ' the registers being updated faster than the video cardπ' can keep up with or sothing like that. If anyone knowsπ' how to fix this, go for it!π'πDOπ 'π CALL ReadRGB(ored%, ogrn%, oblu%, 1) ' Read in slot 1.π 'π FOR t% = 1 TO 254π CALL ReadRGB(red%, grn%, blu%, t% + 1) ' Read slots 2-255, thenπ CALL WriteRGB(red%, grn%, blu%, t%) ' shift to slots 1-254.π NEXT t%π 'π CALL WriteRGB(ored%, ogrn%, oblu%, 255) ' Write what was in slot 1 toπ ' slot 255.π FOR dlay% = 1 TO 15000: NEXT dlay% ' This may need adjustingπLOOP UNTIL INKEY$ <> ""π'πCLSππ'π' Reset original RGB valuesπ'πFOR t% = 0 TO 255π CALL WriteRGB(oldr%(t%), oldg%(t%), oldb%(t%), t%)πNEXT t%ππSUB DRAW.PLASMA (XS%, YS%, XE%, YE%, REDRAW%, SCALE%)π 'π STATIC ITER%π 'π IF REDRAW% THEN ITER% = 1: REDRAW% = 0π IF ITER% = 1 THENπ ITER% = 0π LINE (XS%, YS%)-(XS% + SCALE% - 1, YS% + SCALE% - 1), INT(RND * 63) + 1, BFπ LINE (XE%, YS%)-(XE% + SCALE% - 1, YS% + SCALE% - 1), INT(RND * 63) + 1, BFπ LINE (XS%, YE%)-(XS% + SCALE% - 1, YE% + SCALE% - 1), INT(RND * 63) + 1, BFπ LINE (XE%, YE%)-(XE% + SCALE% - 1, YE% + SCALE% - 1), INT(RND * 63) + 1, BFπ END IFπ 'π SIZE% = (XE% - XS%) / 2π IF SIZE% < SCALE% THEN EXIT SUBπ 'π SIZE% = SIZE% + (INT(RND * 8) - 4)π 'π X1% = XS% + (XE% - XS%) / 2π Y1% = YS% + (YE% - YS%) / 2π 'π C1% = POINT(XS%, YS%)' ULπ C2% = POINT(XE%, YS%)' URπ C3% = POINT(XS%, YE%)' LLπ C4% = POINT(XE%, YE%)' LRπ 'π C5% = (C1% + C2%) / 2 ' UL+URπ C6% = (C1% + C3%) / 2 ' UL+LLπ C7% = (C2% + C4%) / 2 ' UR+LRπ C8% = (C3% + C4%) / 2 ' LL+LRπ C9% = (C5% + C6% + C7% + C8%) / 4 ' MIDπ 'π C5% = C5% + INT(RND * SIZE%) - (SIZE% / 2)π C6% = C6% + INT(RND * SIZE%) - (SIZE% / 2)π C7% = C7% + INT(RND * SIZE%) - (SIZE% / 2)π C8% = C8% + INT(RND * SIZE%) - (SIZE% / 2)π C9% = C9% + INT(RND * SIZE%) - (SIZE% / 2)π 'π IF C5% < 1 THEN C5% = 1π IF C6% < 1 THEN C6% = 1π IF C7% < 1 THEN C7% = 1π IF C8% < 1 THEN C8% = 1π IF C9% < 1 THEN C9% = 1π 'π IF C5% > 63 THEN C5% = 63π IF C6% > 63 THEN C6% = 63π IF C7% > 63 THEN C7% = 63π IF C8% > 63 THEN C8% = 63π IF C9% > 63 THEN C9% = 63π 'π IF XS% = 0 OR YS% = 0 THENπ LINE (XS%, YS%)-(XS% + SCALE% - 1, YS% + SCALE% - 1), C5%, BF' TMπ END IFπ IF XS% = 0 OR Y1% = 0 THENπ LINE (XS%, Y1%)-(XS% + SCALE% - 1, Y1% + SCALE% - 1), C6%, BF' LMπ END IFπ 'π IF XE% < 320 AND Y1% < 200 THENπ LINE (XE%, Y1%)-(XE% + SCALE% - 1, Y1% + SCALE% - 1), C7%, BF' RMπ END IFπ IF X1% < 320 AND YE% < 200 THENπ LINE (X1%, YE%)-(X1% + SCALE% - 1, YE% + SCALE% - 1), C8%, BF' BMπ END IFπ IF X1% < 320 AND Y1% < 200 THENπ LINE (X1%, Y1%)-(X1% + SCALE% - 1, Y1% + SCALE% - 1), C9%, BF' MIDπ END IFπ 'π CALL DRAW.PLASMA(XS%, YS%, X1%, Y1%, REDRAW%, SCALE%)π CALL DRAW.PLASMA(X1%, YS%, XE%, Y1%, REDRAW%, SCALE%)π CALL DRAW.PLASMA(XS%, Y1%, X1%, YE%, REDRAW%, SCALE%)π CALL DRAW.PLASMA(X1%, Y1%, XE%, YE%, REDRAW%, SCALE%)π 'πEND SUBππSUB PLASMA (XE%, YE%, SCALE%)π 'π CALL DRAW.PLASMA(0, 0, XE%, YE%, 1, SCALE%)π LINE (0, 0)-(XE% + SCALE% - 1, YS% + SCALE% - 1), 0, BFπ LINE (0, 0)-(XS% + SCALE% - 1, YE% + SCALE% - 1), 0, BFπ 'πEND SUBππSUB ReadRGB (red%, grn%, blu%, slot%)π 'π OUT &H3C7, slot% ' Read RGB values from slotπ 'π red% = INP(&H3C9)π grn% = INP(&H3C9)π blu% = INP(&H3C9)π 'πEND SUBππSUB SetPal (start.slot%, end.slot%)π 'π num.slots% = end.slot% - start.slot%π 'π CALL ReadRGB(sr%, sg%, sb%, start.slot%)π CALL ReadRGB(er%, eg%, eb%, end.slot%)π 'π rr% = ABS(er% - sr%): rg% = ABS(eg% - sg%): rb% = ABS(eb% - sb%)π rs% = SGN(er% - sr%): gs% = SGN(eg% - sg%): bs% = SGN(eb% - sb%)π 'π stepr = (rr% / num.slots%) * rs%π stepg = (rg% / num.slots%) * gs%π stepb = (rb% / num.slots%) * bs%π 'π r = sr%: g = sg%: b = sb%π wr% = r: wg% = g: wb% = bπ 'π FOR t% = start.slot% TO end.slot%π 'π CALL WriteRGB(wr%, wg%, wb%, t%)π 'π r = r + stepr: wr% = rπ g = g + stepg: wg% = gπ b = b + stepb: wb% = bπ 'π NEXT t%π 'πEND SUBππSUB WriteRGB (red%, grn%, blu%, slot%)π 'π OUT &H3C8, slot% ' Write RGB values to slotπ 'π OUT &H3C9, red%π OUT &H3C9, grn%π OUT &H3C9, blu%π 'πEND SUBπAndrew L. Ayers BUFFER TO SCREEN COPY ROUTINE andrewa@indirect.com 08-21-96 (00:00) QB, QBasic, PDS 93 4093 BCOPY.BAS ' Description : BlastCopy! - VGA Mode 13 Buffer to Screen Copy Routineπ' Get ready for some rock and roll - this baby's fast!π' Written by : Andrew L. Ayersπ' Date : 08/21/96π'π' Ok! Here's one! I am sick of Mode 13h not having a way to PCOPY! So I amπ' setting out to remedy it. First, a rather large buffer is created usingπ' DIMension. Since the smallest data type we can use is WORD size, and modeπ' 13h uses one byte per pixel, and there are 64000 pixels on the screen, weπ' need a buffer 32000 WORDs long. Hence, the following:π'πDIM buffer%(31999), code1%(29)π'π' BTW - buffer%() is the buffer, code%() is an area of memory set aside forπ' the copy routine, see below...π'π' Now we need a copy routine. BASIC is too damn slow for this amount of work,π' so I resorted to assembler (all right, some of you! I hear groaning!).π' Noooooooo! Yes! This works, it isn't hard to understand, just get a goodπ' book! I shied away from assembler myself, but was able to pick up enough toπ' do this routine in a couple of days. So, anyhow here is the assembler code.π'π' Assembler code is as follows:π'π' 1E PUSH DS ' Save the Data Segmentπ' 55 PUSH BP ' Save the Base Pointerπ' 89E5 MOV BP,SP ' Get the Stack Pointerπ' 8B460A MOV AX,[BP+0A] ' Let AX=Buffer Segment Addressπ' 8ED8 MOV DS,AX ' Set the Data Segment=AXπ' 8B7608 MOV SI,[BP+08] ' Let Source Index(SI)=Buffer Offsetπ' B800A0 MOV AX,A000 ' Set AX=Start of Video (13h)π' 8EC0 MOV ES,AX ' Set the Extra Segmentπ' BF0000 MOV DI,0000 ' Set the Destination Index to 0π' B9007D MOV CX,7D00 ' Number of words to copy (32000)π' F3A5 REP MOVSW ' Move the words!π' 5D POP BP ' Reset the Base Pointerπ' 1F POP DS ' Reset the Data Segmentπ' CA0400 RETF 0004 ' Return to BASIC Program, clean upπ' stack...π'π' I know, I know. Some of you assembler freaks out there can see some waysπ' of speeding it up, such as using LDS and LES, or even using the fasterπ' double WORD copy (on 386-486). Well, I used DEBUG, and I was learning, soπ' this is what you get. Speed it up if you want!π'π' And here it is encoded as HEX in a string for us to use...π'πcode1$ = "1E5589E58B460A8ED88B7608B800A08EC0BF0000B9007DF3A55D1FCA0400"π'π' Where did I get the HEX codes? Using DEBUG! DEBUG is what is known as aπ' monitor. It allows you to change/create machine code directly, without anπ' assembler. It isn't hard to learn. Just pick up a copy of PC Magazine'sπ' DOS books - it will show you how to use it. They also have one for BASIC,π' which shows assembler stuff. I used DEBUG instead of MASM, because of twoπ' reasons: 1) I don't have MASM, 2) MASM costs too much. Fortunately, thereπ' are shareware assemblers out there, but since DEBUG comes with DOS, whyπ' not try it?π'π' Now we poke the code into the memory reserved for it:π'πDEF SEG = VARSEG(code1%(0))π'πFOR i% = 0 TO 29π d% = VAL("&h" + MID$(code1$, i% * 2 + 1, 2))π POKE VARPTR(code1%(0)) + i%, d%πNEXT i%π'π' This sets the buffer to "pretty" colorsπ' Some form of assembler is needed here to speed this up - perhaps a newπ' kind of GET/PUT style routine...Hmm...π'πFOR t% = 0 TO 31999π buffer%(t%) = t%πNEXT t%π'π' Gee... What does this line do?...π'πSCREEN 13π'π' Wait for user inputπ'πLOCATE 1, 1: PRINT "Press any key to clear...";πkey$ = INPUT$(1)π'π' Call our routine - MUST pass segment and offset of buffer using BYVAL,π' otherwise you'll get the addresses only - not good...π'πDEF SEG = VARSEG(code1%(0))πCALL ABSOLUTE(BYVAL VARSEG(buffer%(0)), BYVAL VARPTR(buffer%(0)), VARPTR(code1%(0)))πDEF SEGπ'π' As always, you may use this code for whatever you want, just give meπ' credit where you can. Thanx, and have phun!πKurt Kuzba USING GET & PUT FidoNet QUIK_BAS Echo 08-02-96 (14:43) QB, QBasic, PDS 32 1835 GET&PUT.BAS '> Can any one help me with the statements GET adn PUT? Inπ'> screen mode 13? Does anyone know how to display a spriteπ'> that is made with Sprite Editor and is appended into aπ'> QBasic program using the DATA statement? What it does isπ'> put a sprite that you draw in Sprite Editor in QBasic usingπ'> DATA statements?? I don't get it???π'>.....................................π' GET and PUT in mode 13 is simple. You can actually work withπ'the data in your array, unlike with mode 12. I have yet to makeπ'heads or tails of the array data arrived at with the GET in 12.π'You require one byte for each pixel, plus four bytes to hold theπ'block format data, which is two integer values, one for the width,π'and one for the height, of the graphical block. Try this:πSCREEN 13πDIM BUF(602) AS INTEGER '(40x30 + 4 bytes for format data) / 2πBUF(0) = 320 'set block width (in BITS!) 40 * 8πBUF(1) = 30 'set block heightπDEF SEG = VARSEG(BUF(0)): O& = VARPTR(BUF(0)) + 4π 'set segment to directly manipulate BUFπDOπ Colour% = RND * 255π FOR T& = O& TO O& + 1199: POKE T&, Colour%: NEXTπ 'set BUF contents to another color at randomπ X% = RND * 279: Y% = RND * 169 'Pick a random screen location.π IF (Colour% AND 1) <> 0 THEN 'This IF/THEN/ELSE is just forπ PUT (X%, Y%), BUF, PSET 'fun, alternating between theπ ELSE 'absolute PSET usage and theπ PUT (X%, Y%), BUF, XOR 'XOR, combining present imageπ END IF 'with the imposed image. Itπ IF INKEY$ <> "" THEN EXIT DO 'makes the display just a bitπLOOP 'more interesting to watchπSCREEN 0: WIDTH 80, 25: END 'go back to 80x25 text and end.πJonathan Leger GRAPHICS LOADER leger@mail.dtx.net 08-12-96 (21:48) QB, QBasic, PDS 935 26247 FX2.BAS '----------------------------------------------------------π' Requires Luke Molnar's ULTIMATE FONT V1.1π' Please refer to GRAPHICS.ABC of the July 1996 Editionπ'----------------------------------------------------------ππDEFINT A-Zππ'**** Screen routinesπDECLARE SUB LoadGif (file$)πDECLARE SUB LoadPcx (file$)πDECLARE SUB BsaveScreen (file$)πDECLARE SUB GiftoBSAVE (gif$, bsave$, pal$)ππ'*** Palette routinesπDECLARE SUB GetPal (pal())πDECLARE SUB PutPal (pal())πDECLARE SUB SavePal (file$)πDECLARE SUB LoadPal (file$)πDECLARE SUB RotatePal (direction, pal())πDECLARE SUB CyclePal (direction, pal(), numcycles)ππ'*** Palette fxπDECLARE SUB FadeOut (pal())πDECLARE SUB FadeIn (pal())πDECLARE SUB BlackOut ()ππ'*** Drawing RoutinesπDECLARE SUB ClrScr (col)ππ'*** Font routinesπDECLARE SUB Font (Text$, XStart, Ystart, Xscale, Yscale, Style, clr)πDECLARE SUB LoadFont ()πDECLARE SUB MakeFont ()πDECLARE SUB FontPal ()ππ'*** EMS routinesπDECLARE FUNCTION NumEMSHandles% ()πDECLARE FUNCTION NumEMSPages% (Handle%)πDECLARE FUNCTION GetEMS% (numpages%)πDECLARE FUNCTION EMSPages% (func%)πDECLARE FUNCTION PageFrame% ()πDECLARE FUNCTION EMSstatus% ()πDECLARE SUB ReleaseEMS (Handle%)πDECLARE SUB MapEMS (Handle%, block%)ππ'*** Memory manipulation routinesπDECLARE SUB MemCopy (fromseg, fromoff, toseg, tooff, numbytes)πDECLARE SUB FillChar (segment, offset, value, bytes)ππ'*** MiscelaneousπDECLARE SUB WaitRetrace ()ππOPTION BASE 0ππ'$STATICπDIM pal1(0 TO 255, 3) AS INTEGERπDIM pal2(0 TO 255, 3) AS INTEGERπDIM SHARED FontBuf(0) AS STRING * 10368ππ'$DYNAMICππLoadFontππSCREEN 13ππGetPal pal1()ππFontPalπGetPal pal2()πBlackOutππFont "BASIC FX", 50, 75, 3, 3, 3, 70πFadeIn pal2()ππWHILE INKEY$ = "": WENDπFadeOut pal2()πCLSππFont "The font routines were written by:", 0, 0, 1, 1, 3, 120πFont "Luke Molnar", 70, 25, 2, 2, 3, 1πFont "Other routines written/collected by:", 0, 100, 1, 1, 3, 120πFont "Jonathan Leger", 40, 125, 2, 2, 3, 1ππFadeIn pal2()ππWHILE INKEY$ = "": WENDππFadeOut pal2()πCLSππPutPal pal1()ππFont "LoadGif()", 115, 100, 1, 1, 5, 15πFont "press a key", 105, 125, 1, 1, 5, 15πWHILE INKEY$ = "": WENDππLoadGif "letterma.gif"πFOR snd = 1000 TO 1500 STEP 100π SOUND snd, .1π SOUND snd + 100, .1π SOUND snd + 200, .1πNEXT sndππWHILE INKEY$ = "": WENDππCLSπPutPal pal1()ππFont "LoadPcx()", 115, 100, 1, 1, 5, 15πFont "press a key", 105, 125, 1, 1, 5, 15πWHILE INKEY$ = "": WENDππLoadPcx "bwface.pcx"πFOR snd = 1000 TO 1500 STEP 100π SOUND snd, .1π SOUND snd + 100, .1π SOUND snd + 200, .1πNEXT sndππWHILE INKEY$ = "": WENDππIF EMSstatus THENπ IF EMSPages(1) >= 4 THENπ PCXHandle = GetEMS(4)π MapEMS PCXHandle, 0π MemCopy &HA000, 0, PageFrame, 0, &HFA00π CLSπ Font "The previous picture has been", 0, 0, 1, 1, 5, 15π Font "loaded into EMS memory.", 0, 25, 1, 1, 5, 15π Font "Press any key to load picture.", 0, 50, 1, 1, 5, 15π WHILE INKEY$ = "": WENDπ MemCopy PageFrame, 0, &HA000, 0, &HFA00π WHILE INKEY$ = "": WENDπ ReleaseEMS PCXHandleπ END IFπEND IFππGetPal pal2()ππFont "CyclePal()", 115, 100, 1, 1, 5, 15ππDO UNTIL LEN(INKEY$) > 0π CyclePal 1, pal2(), 1πLOOPππBlackOutπCLSππFontPalπGetPal pal2()πBlackOutππFont "End of..", 0, 25, 1, 1, 5, 18πFont "BASIC FX", 50, 75, 3, 3, 3, 70πFont "...Demo", 240, 145, 1, 1, 5, 18πFadeIn pal2()ππWHILE INKEY$ = "": WENDπFadeOut pal2()πCLSπPutPal pal1()ππSCREEN 0πWIDTH 80, 25πENDππREM $STATICπSUB BlackOutππ FOR clr = 0 TO 255π OUT &H3C8, clrπ OUT &H3C9, 0π OUT &H3C9, 0π OUT &H3C9, 0π NEXT clrππEND SUBππSUB BsaveScreen (file$)ππDEF SEG = &HA000πBSAVE file$, 0, 64000πDEF SEGππEND SUBππSUB ClrScr (col)ππFillChar &HA000, 0, col, &HFA00ππEND SUBππSUB CyclePal (direction, pal(), numcycles)ππFOR x = 1 TO numcyclesπ WaitRetraceπ RotatePal direction, pal()πNEXT xππEND SUBππ'************* EMSPages%() ****************π'*** When func% is 0, returns the total ***π'*** number of 16k pages, when func% is ***π'*** 1, returns the number of available ***π'*** 16k pages. ***π'******************************************πFUNCTION EMSPages% (func%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(66) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(8) + CHR$(137) + CHR$(21) + CHR$(93) + CHR$(203)ππTotalPages% = 0: AvailablePages% = 0ππDEF SEG = VARSEG(asm$)π CALL Absolute(TotalPages%, AvailablePages%, SADD(asm$))πDEF SEGππIF func% = 0 THENπ EMSPages% = TotalPages%πELSEπ EMSPages% = AvailablePages%πEND IFππEND FUNCTIONππ'**************** EMSstatus%() ******************π'*** Returns whether EMS is available. -1 is ***π'*** returned if it is available, 0 otherwise ***π'************************************************πFUNCTION EMSstatus%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(64) + CHR$(205) + CHR$(103) + CHR$(176) + CHR$(0)πasm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(6) + CHR$(137) + CHR$(7)πasm$ = asm$ + CHR$(93) + CHR$(203)ππEMS% = -1πDEF SEG = VARSEG(asm$)π CALL Absolute(EMS%, SADD(asm$))πDEF SEGππIF EMS% = 0 THENπ EMSstatus = -1 'EMS installed, set to BASIC's TRUE value.πELSEπ EMSstatus = 0 'EMS not installed, set to FALSE.πEND IFππEND FUNCTIONππSUB FadeIn (pal())ππDIM Tmp(0 TO 255, 3)ππFOR lp = 1 TO 64π FOR clr = 0 TO 255π FOR rgb = 1 TO 3π IF Tmp(clr, rgb) < pal(clr, rgb) THENπ Tmp(clr, rgb) = Tmp(clr, rgb) + 1π END IFπ NEXT rgbπ OUT &H3C8, clrπ OUT &H3C9, Tmp(clr, 1)π OUT &H3C9, Tmp(clr, 2)π OUT &H3C9, Tmp(clr, 3)π NEXT clrπNEXT lpπππEND SUBππSUB FadeOut (pal())ππDIM Tmp(0 TO 255, 3)ππFOR clr = 0 TO 255π FOR rgb = 1 TO 3π Tmp(clr, rgb) = pal(clr, rgb)π NEXT rgbπNEXT clrππFOR lp = 1 TO 64π FOR clr = 0 TO 255π FOR rgb = 1 TO 3π IF Tmp(clr, rgb) > 0 THENπ Tmp(clr, rgb) = Tmp(clr, rgb) - 1π END IFπ NEXT rgbπ OUT &H3C8, clrπ OUT &H3C9, Tmp(clr, 1)π OUT &H3C9, Tmp(clr, 2)π OUT &H3C9, Tmp(clr, 3)π NEXT clrπNEXT lpπππEND SUBππSUB FillChar (segment, offset, value, bytes)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(78) + CHR$(6) + CHR$(139) + CHR$(86) + CHR$(8)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12) + CHR$(30) + CHR$(142)πasm$ = asm$ + CHR$(216) + CHR$(139) + CHR$(94) + CHR$(10) + CHR$(136)πasm$ = asm$ + CHR$(23) + CHR$(67) + CHR$(226) + CHR$(251) + CHR$(31)πasm$ = asm$ + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL segment, BYVAL offset, BYVAL value, BYVAL bytes, SADD(asm$))πDEF SEGππEND SUBππSUB Font (Text$, XStart, Ystart, Xscale, Yscale, Style, clr)ππpx = XStart ' physical x and physical yπpy = YstartππLHeight = Yscale * 8πOptimize = 63 \ LHeight ' Any constant math operations done multipe timesπ ' in the main loop should, well, not be doneπ ' in the main loop.πππ' Instead of wasting our time with all this MID$ garbage to access bytes inπ' font buffer, we'll just take a PEEK directly at them.πDEF SEG = VARSEG(FontBuf(0))ππ FOR h = 1 TO LEN(Text$)π FPtr = 81 * (ASC(MID$(Text$, h, 1)) - 1) - 1π FOR x = 0 TO 8π FOR y = 0 TO 8ππ col = PEEK(VARPTR(FontBuf(0)) + FPtr)π FPtr = FPtr + 1π IF col THENπ SELECT CASE Styleπ ' If you desire a y scale factor greater than 8, youπ ' must change the division to higher precision...very slow.π ' Or, you could find a way around it.π CASE 1: PSET (px, py), Optimize * (py - Ystart) + clrπ LINE (px, py)-(px, py + Yscale), Optimize * (py - Ystart) + clrπ ' Notice how this style only uses 54 colors, so you can see the topπ ' of the letters where they would normally be blackπ CASE 2: CIRCLE (px, py), Yscale, (54 \ LHeight) * (py - Ystart) + clr + 9, , , 4π CASE 3: FOR sty = px TO px + Xscaleπ FOR sty2 = py TO py + Yscaleπ PSET (sty, sty2), Optimize * (sty2 - Ystart) + clrπ IF POINT(sty - 1, sty2) = 0 THEN PSET (sty - 1, sty2), 63 + clr - 1π IF POINT(sty, sty2 - 1) = 0 THEN PSET (sty, sty2 - 1), 63 + clr - 1π NEXTπ NEXTπ CASE 4: FOR sty = px TO px + Xscaleπ FOR sty2 = py TO py + Yscaleπ PSET (sty + .4 * sty2, sty2), Optimize * (sty2 - Ystart) + clrπ IF POINT((sty - 1) + .4 * sty2, sty2) = 0 THEN PSET ((sty - 1) + .4 * sty2, sty2), 63 + clr - 1π NEXTπ NEXTπ CASE ELSEπ PSET (px, py), clrπ END SELECTπ END IFπ py = py + Yscaleπ NEXTπ px = px + Xscaleπ py = Ystartπ NEXTπ NEXT hπDEF SEGππEND SUBππSUB FontPalπFOR x = 1 TO 63π OUT &H3C8, xπ OUT &H3C9, xπ OUT &H3C9, 0π OUT &H3C9, 0πNEXTπFOR x = 64 TO 126π OUT &H3C8, xπ OUT &H3C9, 0π OUT &H3C9, xπ OUT &H3C9, 0πNEXTπFOR x = 127 TO 189π OUT &H3C8, xπ OUT &H3C9, 0π OUT &H3C9, 0π OUT &H3C9, xπNEXTπFOR x = 190 TO 252π OUT &H3C8, xπ OUT &H3C9, xπ OUT &H3C9, 0π OUT &H3C9, xπNEXTπFOR x = 253 TO 255π OUT &H3C8, xπ OUT &H3C9, xπ OUT &H3C9, xπ OUT &H3C9, xπNEXTπEND SUBππ'********************** GetEMS%() ********************π'*** Function returns the handle value for a block ***π'*** of EMS memory that consists of numpages% 16k ***π'*** pages. You _must_ keep the handle value for ***π'*** later calls that require the handle. Example:***π'*** ***π'*** EmsHandle% = GetEMS%(5) ***π'*** ***π'*** EmsHandle% holds the handle info for a block ***π'*** of memory 5 16k pages in size, oh 80k. ***π'*****************************************************πFUNCTION GetEMS% (numpages%)ππ'pageoffset% = EMSPages%(0) - EMSPages%(1)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(94) + CHR$(8) + CHR$(180) + CHR$(67) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(139) + CHR$(94) + CHR$(6) + CHR$(137)πasm$ = asm$ + CHR$(23) + CHR$(93) + CHR$(203)ππHandle% = 0πDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL numpages%, Handle%, SADD(asm$))πDEF SEGππ'asm$ = ""π'asm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)π'asm$ = asm$ + CHR$(86) + CHR$(8) + CHR$(139) + CHR$(126) + CHR$(6)π'asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(10) + CHR$(177) + CHR$(0)π'asm$ = asm$ + CHR$(48) + CHR$(237) + CHR$(180) + CHR$(68) + CHR$(136)π'asm$ = asm$ + CHR$(200) + CHR$(137) + CHR$(243) + CHR$(205) + CHR$(103)π'asm$ = asm$ + CHR$(70) + CHR$(65) + CHR$(57) + CHR$(254) + CHR$(117)π'asm$ = asm$ + CHR$(242) + CHR$(93) + CHR$(203)π'π'DEF SEG = VARSEG(asm$)π' CALL Absolute(BYVAL pageoffset%, BYVAL Handle%, BYVAL numpages%, SADD(asm$))π'DEF SEGππGetEMS% = Handle%ππEND FUNCTIONππSUB GetPal (pal())π FOR clr = 0 TO 255π OUT &H3C7, clrπ pal(clr, 1) = INP(&H3C9)π pal(clr, 2) = INP(&H3C9)π pal(clr, 3) = INP(&H3C9)π NEXT clrπEND SUBππSUB GiftoBSAVE (gif$, bsave$, pal$)ππLoadGif gif$πBsaveScreen bsave$πSavePal pal$ππEND SUBππSUB LoadFontππ fontfile = FREEFILEππ OPEN "basefont.dat" FOR BINARY AS #fontfileπ GET #fontfile, , FontBuf(0)π CLOSE #fontfileππEND SUBππSUB LoadGif (file$)πDIM byte AS STRING * 1πDIM Prefix(4095), Suffix(4095), OutStack(4095), shiftout(8)πDIM Ybase AS LONG, powersof2(11) AS LONG, WorkCode AS LONGππFOR a = 0 TO 7: shiftout(8 - a) = 2 ^ a: NEXT aπFOR a = 0 TO 11: powersof2(a) = 2 ^ a: NEXT aππgiffile = FREEFILEπOPEN file$ FOR BINARY AS #giffileπfile$ = " ": GET #giffile, , file$πIF file$ <> "GIF87a" THEN PRINT "Not a GIF87a file.": ENDπGET #giffile, , TotalX: GET #giffile, , TotalY: GOSUB GetByteπNumColors = 2 ^ ((a AND 7) + 1): NoPalette = (a AND 128) = 0πGOSUB GetByte: Background = aπGOSUB GetByte: IF a <> 0 THEN PRINT "Bad screen descriptor.": ENDπIF NoPalette = 0 THEN P$ = SPACE$(NumColors * 3): GET #giffile, , P$πDOπ GOSUB GetByteπ IF a = 44 THENπ EXIT DOπ ELSEIF a <> 33 THENπ PRINT "Unknown extension type.": ENDπ END IFπ GOSUB GetByteπ DO: GOSUB GetByte: file$ = SPACE$(a): GET #giffile, , file$: LOOP UNTIL a = 0πLOOPπGET #giffile, , XStart: GET #giffile, , Ystart: GET #giffile, , XLength: GET #giffile, , YLengthπXEnd = XStart + XLength: YEnd = Ystart + YLength: GOSUB GetByteπIF a AND 128 THEN PRINT "Can't handle local colormaps.": ENDπInterlaced = a AND 64: PassNumber = 0: PassStep = 8πGOSUB GetByteπClearCode = 2 ^ aπEOSCode = ClearCode + 1πFirstCode = ClearCode + 2: NextCode = FirstCodeπStartCodeSize = a + 1: CodeSize = StartCodeSizeπStartMaxCode = 2 ^ (a + 1) - 1: MaxCode = StartMaxCodeππBitsIn = 0: BlockSize = 0: BlockPointer = 1πx = XStart: y = Ystart: Ybase = y * 320&ππDEF SEG = &HA000ππIF NoPalette = 0 THENπ OUT &H3C7, 0: OUT &H3C8, 0π FOR a = 1 TO NumColors * 3: OUT &H3C9, ASC(MID$(P$, a, 1)) \ 4: NEXT aπEND IFππLINE (0, 0)-(319, 199), Background, BFππDOπ GOSUB GetCodeπ IF Code <> EOSCode THENπ IF Code = ClearCode THENπ NextCode = FirstCodeπ CodeSize = StartCodeSizeπ MaxCode = StartMaxCodeπ GOSUB GetCodeπ CurCode = Code: LastCode = Code: LastPixel = Codeπ IF x < 320 THEN POKE x + Ybase, LastPixelπ x = x + 1: IF x = XEnd THEN GOSUB NextScanLineπ ELSEπ CurCode = Code: StackPointer = 0π IF Code > NextCode THEN EXIT DOπ IF Code = NextCode THENπ CurCode = LastCodeπ OutStack(StackPointer) = LastPixelπ StackPointer = StackPointer + 1π END IFππ DO WHILE CurCode >= FirstCodeπ OutStack(StackPointer) = Suffix(CurCode)π StackPointer = StackPointer + 1π CurCode = Prefix(CurCode)π LOOPππ LastPixel = CurCodeπ IF x < 320 THEN POKE x + Ybase, LastPixelπ x = x + 1: IF x = XEnd THEN GOSUB NextScanLineππ FOR a = StackPointer - 1 TO 0 STEP -1π IF x < 320 THEN POKE x + Ybase, OutStack(a)π x = x + 1: IF x = XEnd THEN GOSUB NextScanLineπ NEXT aππ IF NextCode < 4096 THENπ Prefix(NextCode) = LastCodeπ Suffix(NextCode) = LastPixelπ NextCode = NextCode + 1π IF NextCode > MaxCode AND CodeSize < 12 THENπ CodeSize = CodeSize + 1π MaxCode = MaxCode * 2 + 1π END IFπ END IFπ LastCode = Codeπ END IFπ END IFπLOOP UNTIL DoneFlag OR Code = EOSCodeπGOTO LeaveProcππGetByte: file$ = " ": GET #giffile, , file$: a = ASC(file$): RETURNππNextScanLine:π IF Interlaced THENπ y = y + PassStepπ IF y >= YEnd THENπ PassNumber = PassNumber + 1π SELECT CASE PassNumberπ CASE 1: y = 4: PassStep = 8π CASE 2: y = 2: PassStep = 4π CASE 3: y = 1: PassStep = 2π END SELECTπ END IFπ ELSEπ y = y + 1π END IFπ x = XStart: Ybase = y * 320&: DoneFlag = y > 199πRETURNπGetCode:π IF BitsIn = 0 THEN GOSUB ReadBufferedByte: LastChar = a: BitsIn = 8π WorkCode = LastChar \ shiftout(BitsIn)π DO WHILE CodeSize > BitsInπ GOSUB ReadBufferedByte: LastChar = aπ WorkCode = WorkCode OR LastChar * powersof2(BitsIn)π BitsIn = BitsIn + 8π LOOPπ BitsIn = BitsIn - CodeSizeπ Code = WorkCode AND MaxCodeπRETURNπReadBufferedByte:π IF BlockPointer > BlockSize THENπ GOSUB GetByte: BlockSize = aπ file$ = SPACE$(BlockSize): GET #giffile, , file$π BlockPointer = 1π END IFπ a = ASC(MID$(file$, BlockPointer, 1)): BlockPointer = BlockPointer + 1πRETURNπLeaveProc:πCLOSEππEND SUBππSUB LoadPal (file$)ππpalfile = FREEFILEπOPEN file$ FOR BINARY AS palfileππFOR clr = 0 TO 255π OUT &H3C8, clrπ OUT &H3C9, ASC(INPUT$(1, palfile))π OUT &H3C9, ASC(INPUT$(1, palfile))π OUT &H3C9, ASC(INPUT$(1, palfile))πNEXT clrππCLOSE palfileππEND SUBππSUB LoadPcx (file$)πpcxfile = FREEFILEπOPEN file$ FOR BINARY AS pcxfileππDEF SEG = &HA000π π SEEK #pcxfile, LOF(1) - 767π FOR pal = 0 TO 255π OUT &H3C8, palπ rgb% = ASC(INPUT$(1, pcxfile))π OUT &H3C9, rgb% / 4π rgb% = ASC(INPUT$(1, pcxfile))π OUT &H3C9, rgb% / 4π rgb% = ASC(INPUT$(1, pcxfile))π OUT &H3C9, rgb% / 4π NEXT palπ SEEK #pcxfile, 129π c = 0π WHILE c < 32000π clr = ASC(INPUT$(1, pcxfile))π IF clr > 192 AND clr <= 255 THENπ LPS = clr - 192π clr = ASC(INPUT$(1, pcxfile))π FOR L = LPS TO 1 STEP -1π POKE c, clrπ c = c + 1π LPS = LPS - 1π NEXT Lπ ELSEπ POKE c, clrπ c = c + 1π END IFπ WENDπ c = 0π DEF SEG = &HA7D0π WHILE c < 32000π clr = ASC(INPUT$(1, pcxfile))π IF clr > 192 AND clr <= 255 THENπ LPS = clr - 192π clr = ASC(INPUT$(1, pcxfile))π FOR L = LPS TO 1 STEP -1π POKE c, clrπ c = c + 1π LPS = LPS - 1π NEXT Lπ ELSEπ POKE c, clrπ c = c + 1π END IFπ WENDπCLOSEπDEF SEGππEND SUBππSUB MakeFontππfontfile = FREEFILEππOPEN "basefont.dat" FOR BINARY AS #giffileπ' Hey, change 128 to 255 for the full font.πCLSπSCREEN 13πCOLOR 16πFOR ascii = 1 TO 128π CLSπ PRINT CHR$(ascii)π FOR x = 0 TO 8π FOR y = 0 TO 8π pnt$ = CHR$(POINT(x, y))π PUT #giffile, , pnt$π pnt$ = ""π NEXTπ NEXTπNEXTπCLOSEπOPEN "basefont.dat" FOR BINARY AS #giffileπ GET #giffile, , FontBuf(0)πCLOSE #giffileπEND SUBππ'***************** MapEMS () ***********************************π'*** Sets the page of a memory block (identified by Handle%) ***π'*** that is located at the beginning of the page frame. ***π'*** Example: ***π'*** ***π'*** EmsHandle% = GetEMS%(8) ***π'*** MapEMS EmsHandle%, 4 ***π'*** ***π'*** When the page frame segment is next written to, the info***π'*** will be placed starting at the 4th page in the block of ***π'*** memory represented by EmsHandle%. This could be use, ***π'*** for instance, to store multiple SCREEN 13 images in one ***π'*** EMS block, by moving the first 64k image into the first ***π'*** 4 16k pages (16000 * 4 = 64000) by using: ***π'*** ***π'*** MapEMS EmsHandle%, 0 ***π'*** ***π'*** And then putting the next 64k image into the next 4 EMS ***π'*** pages by using: ***π'*** ***π'*** MapEMS EmsHandle%, 4 ***π'*** ***π'*** ... and then moving the image into the memory block. ***π'***************************************************************πSUB MapEMS (Handle%, pageoffset%)ππnumpages% = 4ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(86) + CHR$(8) + CHR$(139) + CHR$(126) + CHR$(6)πasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(10) + CHR$(177) + CHR$(0)πasm$ = asm$ + CHR$(48) + CHR$(237) + CHR$(180) + CHR$(68) + CHR$(136)πasm$ = asm$ + CHR$(200) + CHR$(137) + CHR$(243) + CHR$(205) + CHR$(103)πasm$ = asm$ + CHR$(70) + CHR$(65) + CHR$(57) + CHR$(249) + CHR$(117)πasm$ = asm$ + CHR$(242) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL pageoffset%, BYVAL Handle%, BYVAL numpages%, SADD(asm$))πDEF SEGππEND SUBππSUB MemCopy (fromseg, fromoff, toseg, tooff, bytes)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(30)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10) + CHR$(142) + CHR$(192)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14) + CHR$(142) + CHR$(216)πasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(12) + CHR$(139) + CHR$(78) + CHR$(6) + CHR$(243)πasm$ = asm$ + CHR$(164) + CHR$(31) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL fromseg, BYVAL fromoff, BYVAL toseg, BYVAL tooff, BYVAL bytes, SADD(asm$))πDEF SEGππEND SUBππ'****************************** NumEMSHandles%() *********************π'*** Returns the number of EMS handles presently being used (there ***π'*** are a maximum of 256 handles possible at any given time). ***π'*********************************************************************πFUNCTION NumEMSHandles%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(75) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(93) + CHR$(203)ππNumHandles% = 0πDEF SEG = VARSEG(asm$)π CALL Absolute(NumHandles%, SADD(asm$))πDEF SEGππNumEMSHandles% = NumHandles%ππEND FUNCTIONππ'***************************** NumEMSPages%() *************************π'*** Returns the number of 16k pages being used by the memory block ***π'*** that is represented by Handle%. ***π'**********************************************************************πFUNCTION NumEMSPages% (Handle%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(86) + CHR$(6) + CHR$(180) + CHR$(76) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(139) + CHR$(126) + CHR$(8) + CHR$(137)πasm$ = asm$ + CHR$(29) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(numpages%, Handle%, SADD(asm$))πDEF SEGππNumEMSPages% = numpages%ππEND FUNCTIONππ'******************************* PageFrame% ***************************π'*** Returns the segment that you will need to write to in order to ***π'*** store your data into EMS memory. For example, PageFrame% may ***π'*** return D000 (HEX, -12288 decimal), and then you might do this: ***π'*** ***π'*** DEF SEG = PageFrame% 'D000 ***π'*** MyData$ = "This is a block of data I want to store in EMS." ***π'*** FOR X = 1 TO LEN(MyData$) ***π'*** POKE X, ASC(MID$(MyData$, X, 1)) ***π'*** NEXT X ***π'*** DEF SEG ***π'*** ***π'*** Note, though, that you have to have a block of EMS opened with ***π'*** GetEMS%() and maped with MapEMS before you can write to the ***π'*** block. ***π'**********************************************************************πFUNCTION PageFrame%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(65) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(93) + CHR$(203)ππPageFrameAddr% = 0πDEF SEG = VARSEG(asm$)π CALL Absolute(PageFrameAddr%, SADD(asm$))πDEF SEGππPageFrame% = PageFrameAddr%ππEND FUNCTIONππSUB PutPal (pal())π π FOR clr = 0 TO 255π OUT &H3C8, clrπ OUT &H3C9, pal(clr, 1)π OUT &H3C9, pal(clr, 2)π OUT &H3C9, pal(clr, 3)π NEXT clrππEND SUBππ'****************************** ReleaseEMS() **************************π'*** Releases the EMS memory associated with Handle%. This is very ***π'*** important to do before you exit your program, otherwise the ***π'*** memory being used by your open handles will not be available ***π'*** again until you reboot. ***π'**********************************************************************πSUB ReleaseEMS (Handle%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(69) + CHR$(139) + CHR$(86) + CHR$(6) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL Handle%, SADD(asm$))πDEF SEGππEND SUBππSUB RotatePal (direction, pal())ππ SELECT CASE directionπ CASE 1π temp1 = pal(255, 1)π temp2 = pal(255, 2)π temp3 = pal(255, 3)π FOR rgb = 1 TO 3π FOR col = 254 TO 0 STEP -1π pal(col + 1, rgb) = pal(col, rgb)π NEXT colπ NEXT rgbπ pal(0, 1) = temp1π pal(0, 2) = temp2π pal(0, 3) = temp3π CASE -1π temp1 = pal(0, 1)π temp2 = pal(0, 2)π temp3 = pal(0, 3)π FOR rgb = 1 TO 3π FOR col = 0 TO 254π pal(col, rgb) = pal(col + 1, rgb)π NEXT colπ NEXT rgbπ pal(255, 1) = temp1π pal(255, 2) = temp2π pal(255, 3) = temp3π END SELECTππ PutPal pal()ππEND SUBππSUB SavePal (file$)ππ palfile = FREEFILEπ OPEN file$ FOR OUTPUT AS palfileππ FOR clr = 0 TO 255π OUT &H3C7, clrπ PRINT #palfile, CHR$(INP(&H3C9));π PRINT #palfile, CHR$(INP(&H3C9));π PRINT #palfile, CHR$(INP(&H3C9));π NEXT clrππ CLOSE palfileππEND SUBππSUB SetPal (pal())πEND SUBππSUB WaitRetraceπ WAIT &H3DA, 8πEND SUBπBrent P. Newhall 2D POLYGON ENGINE comp.lang.basic.misc 08-22-96 (11:30) QB, QBasic, PDS 223 5653 2DPOLY.BAS 'This is a C-to-BASIC conversion from Andre LaMothe's book "Teachπ'Yourself Game Programming in 21 Days". It's a simple demo with threeπ'asteroids twirling on the screen and a scrolling starfield in theπ'background.ππ'If you have need, take it and use it. There are enough SUBs to do mostπ'of what you should need to do.ππ' Polygonπ' by Brent P. Newhall (BrentN@juno.com)ππDEFINT A-ZππCONST FALSE = 0, TRUE = NOT FALSEπCONST MAX.VERTICES = 15πCONST MAX.STARS = 30ππTYPE VertexTypeπ x AS SINGLEπ y AS SINGLEπEND TYPEπTYPE PolygonTypeπ border AS INTEGER ' Border colorπ interior AS INTEGER ' Interior colorπ closed AS INTEGER ' Is the polygon closed?π filled AS INTEGER ' Is the polygon filled?π lxo AS INTEGER ' Local X originπ lyo AS INTEGER ' Local Y originπ NumVertices AS INTEGERπEND TYPEπTYPE StarTypeπ x AS INTEGERπ y AS INTEGERπ dist AS INTEGERπEND TYPEππDECLARE SUB CreateTables ()πDECLARE SUB DrawPolygon (poly AS PolygonType, polyvert() AS VertexType)πDECLARE SUB ErasePolygon (poly AS PolygonType, polyvert() AS VertexType)πDECLARE SUB MovePolygon (poly AS PolygonType, dx AS INTEGER, dy AS INTEGER)πDECLARE SUB ScalePolygon (poly AS PolygonType, polyvert() AS VertexType, scale AS SINGLE)πDECLARE SUB RotatePolygon (poly AS PolygonType, polyvert() AS VertexType, angle AS INTEGER)πDECLARE SUB StarField ()ππDIM ast1 AS PolygonType ' Create basic asteroidsπDIM ast2 AS PolygonTypeπDIM ast3 AS PolygonTypeπast1.NumVertices = 5πast2.NumVertices = 5πast3.NumVertices = 5πREDIM astvert1(1 TO ast1.NumVertices) AS VertexType ' Create verticesπREDIM astvert2(1 TO ast2.NumVertices) AS VertexTypeπREDIM astvert3(1 TO ast3.NumVertices) AS VertexTypeπDIM SHARED star(1 TO MAX.STARS) AS StarTypeπDIM SHARED SinLook(0 TO 361) AS DOUBLE, CosLook(0 TO 361) AS DOUBLEπDIM SHARED c(1 TO 3) ' Colorπc(1) = 15: c(2) = 7: c(3) = 8ππFOR cnt = 1 TO MAX.STARS ' Define all the starsπ star(cnt).x = INT(RND * 320) ' Create random positionπ star(cnt).y = INT(RND * 200)π star(cnt).dist = INT(RND * 3 + 1)πNEXT cntππast1.border = 8πast1.interior = 8πast1.closed = TRUEπast1.filled = FALSEπast1.lxo = 110πast1.lyo = 100πFOR cnt1 = 1 TO ast1.NumVerticesπ READ astvert1(cnt1).x, astvert1(cnt1).yπNEXT cnt1πast2.border = 8πast2.interior = 8πast2.closed = TRUEπast2.filled = FALSEπast2.lxo = 160πast2.lyo = 80πFOR cnt1 = 1 TO ast2.NumVerticesπ READ astvert2(cnt1).x, astvert2(cnt1).yπNEXT cnt1πast3.border = 8πast3.interior = 8πast3.closed = TRUEπast3.filled = FALSEπast3.lxo = 210πast3.lyo = 100πFOR cnt1 = 1 TO ast3.NumVerticesπ READ astvert3(cnt1).x, astvert3(cnt1).yπNEXT cnt1ππPRINT "Creating tables...."πCreateTablesπSCREEN 7ππDOπ StarFieldπ RotatePolygon ast1, astvert1(), 5π RotatePolygon ast2, astvert2(), 8π RotatePolygon ast3, astvert3(), -4π DrawPolygon ast1, astvert1()π DrawPolygon ast2, astvert2()π DrawPolygon ast3, astvert3()π t! = TIMER: WHILE t! = TIMER: WEND ' Pauseπ ErasePolygon ast1, astvert1()π ErasePolygon ast2, astvert2()π ErasePolygon ast3, astvert3()π IF INKEY$ <> "" THEN quit = 1πLOOP UNTIL quit > 0πENDππ' Asteroid 1 verticesπDATA 0,-15πDATA 20, 5πDATA 5, 7πDATA -1, 10πDATA -4, 1ππ' Asteroid 2 verticesπDATA 0,-15πDATA 20,-9πDATA 10, 7πDATA -1, 10πDATA -4, 1ππ' Asteroid 3 verticesπDATA 0,-15πDATA 10,-2πDATA 5, 7πDATA -1, 10πDATA -9, 1ππDEFSNG A-ZπSUB CreateTablesππFOR cnt = 0 TO 360π CosLook(cnt) = COS(cnt * 3.14159 / 180)π SinLook(cnt) = SIN(cnt * 3.14159 / 180)πNEXT cntππEND SUBππSUB DrawPolygon (poly AS PolygonType, polyvert() AS VertexType)ππxo = poly.lxoπyo = poly.lyoππFOR cnt = 1 TO poly.NumVertices - 1π LINE (xo + polyvert(cnt).x, yo + polyvert(cnt).y)-(xo + polyvert(cnt + 1).x, yo + polyvert(cnt + 1).y), poly.borderπNEXT cntππIF poly.closed THENπ LINE (xo + polyvert(poly.NumVertices).x, yo + polyvert(poly.NumVertices).y)-(xo + polyvert(1).x, yo + polyvert(1).y), poly.borderπEND IFππEND SUBππSUB ErasePolygon (poly AS PolygonType, polyvert() AS VertexType)ππxo = poly.lxoπyo = poly.lyoππFOR cnt = 1 TO poly.NumVertices - 1π LINE (xo + polyvert(cnt).x, yo + polyvert(cnt).y)-(xo + polyvert(cnt + 1).x, yo + polyvert(cnt + 1).y), 0πNEXT cntππIF poly.closed THENπ LINE (xo + polyvert(poly.NumVertices).x, yo + polyvert(poly.NumVertices).y)-(xo + polyvert(1).x, yo + polyvert(1).y), 0πEND IFππEND SUBππSUB MovePolygon (poly AS PolygonType, dx AS INTEGER, dy AS INTEGER)ππpoly.lxo = poly.lxo + dxπpoly.lyo = poly.lyo + dyππEND SUBππSUB RotatePolygon (poly AS PolygonType, polyvert() AS VertexType, angle AS INTEGER)ππIF angle >= 0 THENπ si = SinLook(angle)π cs = CosLook(angle)πELSEπ si = SinLook(angle + 360)π cs = CosLook(angle + 360)πEND IFππFOR cnt = 1 TO poly.NumVerticesπ rx = polyvert(cnt).x * cs - polyvert(cnt).y * siπ ry = polyvert(cnt).y * cs + polyvert(cnt).x * siπ polyvert(cnt).x = rxπ polyvert(cnt).y = ryπNEXT cntππEND SUBππSUB ScalePolygon (poly AS PolygonType, polyvert() AS VertexType, scale AS SINGLE)ππFOR cnt = 1 TO poly.NumVerticesπ polyvert(cnt).x = polyvert(cnt).x * scaleπ polyvert(cnt).y = polyvert(cnt).y * scaleπNEXT cntππEND SUBππDEFINT A-ZπSUB StarFieldππFOR cnt = 1 TO MAX.STARSπ PSET (star(cnt).x, star(cnt).y), 0π star(cnt).y = star(cnt).y + (4 - star(cnt).dist)π IF star(cnt).y > 199 THENπ star(cnt).x = INT(RND * 320)π star(cnt).y = INT(RND * 200)π star(cnt).dist = INT(RND * 3 + 1)π END IFπ PSET (star(cnt).x, star(cnt).y), c(star(cnt).dist)πNEXT cntππEND SUBπKurt Eckhardt VARIABLE PLASMA EFFECT king@shadow.net 08-24-96 (00:00) QB, QBasic, PDS 197 6164 PLASMA.BAS DECLARE SUB Info ()πDECLARE SUB RotatePalette (k$)πDECLARE SUB RunX ()πDECLARE SUB RunY ()πDECLARE SUB SetPts ()πDECLARE SUB SetPalette ()π'Coded and designed by Kurt Eckhardt on 08/22/96π'Copyrite 1996 by Kurt Eckhardtπ'Fastened by Steven de Brouwer <SPMdB@dds.nl> on 08/24/96π'π'This program sets up a grid of four points (the corners) and generatesπ'a faded verticle line between them. It then does this horizontallyπ'to create of sort of plasma effect.π'The effect works best when there is a diversity of colors on both sidesπ'of the screen. This way the colors don't just fade, but rather scroll.π'You'll see...π'πDEFINT A-ZπDIM SHARED pal(192, 3)πCLS : CLEARπRANDOMIZE TIMERπCALL InfoππSCREEN 13πPRINT "Loading Palette...": SetPaletteπCLSπDOπ CALL SetPtsπ CALL RunYπ CALL RunXπ DOπ CALL RotatePalette(k$)π LOOP UNTIL k$ <> ""πLOOP UNTIL k$ = CHR$(27)ππSUB InfoπCLSπPRINT SPACE$(30); "Information": PRINTπPRINT "Coded and Designed by Kurt Eckhardt"πPRINT "Copyrite 1996 All Rights Reserved"πPRINT "V2.0 Completed on 8/22/96"πPRINT "V2.0.0a Improved on 8/24/96"πPRINT " by Steven <SPMdB@dds.nl> de Brouwer"πPRINTπPRINT "This program works best when there is a diversity of colors on both"πPRINT "sides of the screen. This creates a nicer pattern on the screen"πPRINT "with more colors, so the scrolling effect will be much nicer."πPRINT "Also experiment with pressing Other Keys! It's fun..."πPRINTπPRINT " Enjoy!"πPRINT : PRINTπPRINT "Escape : Exit Program"πPRINT "SpaceBar : Change Direction"πPRINT "Other Keys: Change Pattern/ Pallette"πDO: LOOP UNTIL INKEY$ <> "": CLSπPRINT SPACE$(30); "Help the student": PRINTπPRINT "If this program brings a smile to your face, or you find any techniques"πPRINT "helpful in you own programming endevours, I would greatly appreciate you"πPRINT "sending me 1$ so I can make my way through college. Right now I am struggling"πPRINT "as I have no money!"πPRINT "I bet you can look around right now and find one buck within 10 feet"πPRINT "of yourself- if not, you are as broke as I am."πPRINT "Any comments or questions, send me some email at <king@shadow.net>"πPRINT "Here's the address for that measly buck: "πPRINTπPRINT "Kurt Eckhardt"πPRINT "1820 West Oak Knoll Circle"πPRINT "Ft. Lauderdale FL 33324"πPRINTπPRINT "Thanks!"πDO: LOOP WHILE INKEY$ = ""πCLSπPRINT SPACE$(35); "Legal Stuff"πPRINTπPRINT "1. This program may be freely distributed so long as no changes have been made."πPRINT "2. This program, or any part of it, may not be used in another program"πPRINT " without my written consent."πPRINT "3. I, Kurt Eckhardt, retain all rights to this code and retain the power"πPRINT " to invoke them at anytime I see fit."πPRINT "4. I take no responsibilty for any adverse affects that may be caused by"πPRINT " usage of this program upon your machine."πPRINT "5. Acknowledge your pleasure by e-mail to SPMdB@dds.nl"πPRINT " (He loves e-mail!)"πLOCATE 15, 13πPRINT "By possessing this program you agree with these terms."πDO: LOOP WHILE INKEY$ = ""ππEND SUBππSUB RotatePalette (n$)π 'π STATIC cngdiv, cng 'Keep values of these two between callsπ IF cngdiv = 0 THEN cngdiv = 1 - INT(RND * 2) * 2 'Random directionπ cng = cng - cngdivπ IF cng < 1 THEN cng = 192π IF cng > 192 THEN cng = 1π s = (1 - SGN(cngdiv)) / 2 's=0 or s=1π 'π IF cng <> 1 + s * 191 THENπ FOR lp = 1 TO 3π pal(cng, lp) = pal(cng - cngdiv, lp)π NEXT lpπ ELSEπ FOR lp = 1 TO 3π pal(1 + s * 191, lp) = pal(192 - s * 191, lp)π NEXT lpπ END IFπ 'π OUT &H3C8, cng 'Write Palette Registerπ OUT &H3C9, pal(cng, 1) 'Write Palette Data(RGB)π OUT &H3C9, pal(cng, 2)π OUT &H3C9, pal(cng, 3)π 'π n$ = INKEY$π IF n$ = " " THEN n$ = "": cngdiv = -cngdiv 'Change directionπ 'πEND SUBππSUB RunXπ π r = INT(RND * 10) ' These two lines plus 'STEP 10'π FOR x = 0 TO 9 ' For the luxaflex-effectπ FOR yy = 0 TO 199 STEP 10π y = yy + (x + r) MOD 10 'This one too :)π ch = POINT(319, y): cl = POINT(0, y)π cdiv! = (ch - cl) / 319π FOR i = 1 TO 318π PSET (i, y), cl + INT(i * cdiv!) 'Interpolate colorπ 'π CALL RotatePalette(k$) 'these three linesπ IF k$ = CHR$(27) THEN END 'for effects during redrawπ IF k$ <> "" THEN stp = 1π 'π NEXT iπ IF stp = 1 THEN LINE (0, 0)-(319, 199), 0, B: EXIT SUBπ NEXT yyπ NEXT xπ LINE (0, 0)-(319, 199), 0, Bπ πEND SUBππSUB RunYπ π FOR i = 0 TO 1π ch = POINT(i * 319, 199): cl = POINT(i * 319, 0)π FOR j = 1 TO 198π PSET (i * 319, j), cl + INT((j / 199) * (ch - cl))π NEXT jπ NEXT iπ πEND SUBππSUB SetPaletteπ π RA = 1: GA = 0: BA = 0: Rval = 63π FOR cnt = 1 TO 192π Rval = Rval + RAπ Gval = Gval + GAπ Bval = Bval + BAπ π IF Rval > 62 AND Gval <> 63 AND Bval = 0 THEN GA = 2π IF Gval > 62 AND Bval <> 63 AND Rval = 0 THEN BA = 2π IF Bval > 62 AND Rval <> 63 AND Gval = 0 THEN RA = 2π π IF Gval > 62 AND Rval > 62 THEN RA = -2π IF Rval < 0 AND Gval > 62 THEN BA = 2π IF Gval > 62 AND Bval > 62 THEN GA = -2π IF Gval < 0 AND Bval > 62 THEN RA = 2π IF Rval > 62 AND Bval > 62 THEN BA = -2π IF Bval < 0 AND Rval > 62 THEN GA = 2π π IF Rval > 62 THEN Rval = 63π IF Rval < 0 THEN Rval = 0π IF Gval > 62 THEN Gval = 63π IF Gval < 0 THEN Gval = 0π IF Bval > 62 THEN Bval = 63π IF Bval < 0 THEN Bval = 0π pal(cnt, 1) = Rvalπ pal(cnt, 2) = Gvalπ pal(cnt, 3) = Bvalπ OUT &H3C8, cntπ OUT &H3C9, Rvalπ OUT &H3C9, Gvalπ OUT &H3C9, Bvalπ NEXT cntπ πEND SUBππSUB SetPtsπ π FOR x = 0 TO 1π PSET (x * 319, 0), (RND * 191) + 2π PSET (x * 319, 199), (RND * 191) + 2π NEXT xπ πEND SUBππErika Schulze TGA VIEWER 100775.2275@CompuServe.com 08-29-96 (18:39) QB, QBasic, PDS 243 10390 TGA.BAS '***************************************************************************π'Program: TGA.BAS *π'Task: TGA viewer for SCREEN 13 - uncompressed TGA files. *π' Version 1.0 *π'Language: QBASIC mixed with machine code. *π'Author: Erika Schulze *π' CIS: 100775,2275 *π' Internet: 100775.2275@compuserve.com *π' Free for use. *π' Use it, abuse it, but don't blame me! *π'Note: It seems to me that the main problem is reading the data *π' from the disk; that's to slow. If somebody has a better *π' solution for this - your assistance is welcome. Please *π' send me a message with your suggestions for improvements. *π'***************************************************************************ππ'The TGA (True Version Targa) isn't complicated. There is only aπ'TGA header of 18 bytes with all informations about the image.π'Structure of the TGA header:ππ'Offset Length Descriptionπ'====== ====== ===========ππ'00H BYTE info:π' It's possible, that after the 18 bytes of theπ' header, the file contains an information block.π' This block, for example, holds the copyrightπ' information. The byte info stands for theπ' length of the information block.π'01H BYTE colortyp:π' 0 ===> RGB imageπ' 1 ===> image has a DAC tableπ'02H BYTE imagetyp:π' This byte contains information about the imageπ' typ:π' 1 ===> uncompressed image datas with a DACπ' tableπ' 2 ===> uncompressed RGB fileπ' 9 ===> runlength encoded datas with a DAC tableπ' 10 ===> runlength encoded RGB fileπ'03H WORD origin:π' This word contains the index of the first entryπ' in the DAC table (mostly 0).π'05H WORD colnumber:π' This word contains the number of colors in theπ' DAC table. That's not the length of the DACπ' table in byte!π'07H BYTE entrybits:π' Size of on entry in the DAC table. An entry hasπ' 16, 24 or 32 bits.π'08H WORD xvalue:π' The x-value of the lower left corner of theπ' TGA image (mostly 0).π'0AH WORD yvalue:π' The y-value of the lower left corner of theπ' TGA image (mostly 0).π'0CH WORD widt:π' The image width in pixels.π'0EH WORD height:π' The image height in pixels.π'10H BYTE pixelsize:π' Number of bits per pixel.π' DAC images ===> valid values are 8 and 16π' RGB images ===> valid values are 16, 24 and 32π'11H BYTE descriptor:π' The image descriptor contains additionalπ' informations.ππ'The structure of the image descriptor:ππ'Bit 0 - 3: fill bitsπ'Bit 4 : always 0π'Bit 5 : 0 ===> image origin in the lower left cornerπ' 1 ===> image origin in the upper left cornerπ'Bit 6 - 7: 00 ===> the image rows are stored one after the otherπ' 01 ===> first are stored the even rows (0, 2, 4 ...)π' after this are stored the odd rows (1, 3, 5 ...)ππ'The formula to calculate the length of the DAC table:ππ'daclength% = colnumber*entrybits/8ππ'After the 18 bytes of the TGA header is stored the informationπ'block in the TGA file, but the length of this block is mostly 0.π'After the information block is stored the DAC table and then theπ'image datas.ππ'===========================================================================π'Program starts here. =π'===========================================================================ππDECLARE SUB Reading (x%, y%)πDECLARE SUB Waiting ()πTYPE tgaheader 'declare the headerπ info AS STRING * 1 'length of image information blockπ colortyp AS STRING * 1 'DAC table or BGR formatπ imagetyp AS STRING * 1 'compressed or uncompressedπ origin AS INTEGER 'first entry in the DAC tableπ colnumber AS INTEGER 'number of colors in the DAC tableπ entrybits AS STRING * 1 'entry size in the DAC tableπ xvalue AS INTEGER 'x co-ordinate lower left cornerπ yvalue AS INTEGER 'y co-ordinate lower left cornerπ widt AS INTEGER 'image widthπ height AS INTEGER 'image heightπ pixelsize AS STRING * 1 'number of bits per pixelπ descriptor AS STRING * 1 'image descriptorπEND TYPEπDIM header AS tgaheader 'define the headerπDIM set%(42) 'machine code array for pixel set procedureπsetseg% = VARSEG(set%(0))πsetoff% = VARPTR(set%(0)) 'start address for pixel set routineπDIM text%(4) 'machine code array for text mode procedureπtextseg% = VARSEG(text%(0))πtextoff% = VARPTR(text%(0)) 'start address text mode procedureπfile$ = "ELENA.TGA" 'change it, if necessaryπfilelength& = 0 'length of the TGA fileπdaclength% = 0 'length of the DAC tableπnumcolors% = 0 'number of used colorsπdacstart& = 0 'start of the DAC values in theπ 'TGA fileπdacend& = 0 'end of the DAC valuesπimstart& = 0 'start of the image data in theπ 'TGA fileπCLSπRESTORE setpixelπCALL Reading(setseg%, setoff%) 'read the machine code (pixel procedure)πRESTORE textmodeπCALL Reading(textseg%, textoff%)'read the machine code (text mode routine)πOPEN file$ FOR BINARY AS #1 'open the TGA fileπfilelength& = LOF(1) 'determine the file lengthπGET #1, 1, header 'read the headerπCLOSE #1 'close the fileπIF ASC(header.colortyp) <> 1 THENπ 'image hasn't a DAC tableπ PRINTπ PRINT "Sorry! This TGA image hasn't a DAC table."π ENDπEND IFπIF ASC(header.imagetyp) <> 1 THENπ 'data must be uncompressedπ PRINTπ PRINT "Sorry! This TGA format isn't supported."π ENDπEND IFπdaclength% = header.colnumber * ASC(header.entrybits) / 8π 'calculate the length of th DAC tableπnumcolors% = daclength% / 3 'calculate the number of used colorsπdacstart& = 19 + ASC(header.info)π 'calculate the DAC startπdacend& = dacstart& + daclength%π 'calculate the DAC endπPRINTπPRINT "Information about the image:"πPRINT "============================"πPRINTπPRINT "Number of used colors ="; header.colnumberπPRINT "Image width ="; header.widt; "Pixel"πPRINT "Image height ="; header.height; "Pixel"πPRINTπPRINT "Please press any key ..."πCALL WaitingπCLS 'clear the screenπSCREEN 13 'VGA 320 by 200 pixel and 256 colorsπOPEN file$ FOR BINARY AS #1 'open the TGA fileπSEEK #1, dacstart& 'start of the DAC tableπFOR register% = 0 TO 255 'set the DAC registersπ temp$ = SPACE$(3) 'temporary stringπ GET #1, , temp$ 'read BGR valueπ red% = ASC(MID$(temp$, 3)) \ 4π 'we need only 6 Bitsπ green% = ASC(MID$(temp$, 2)) \ 4π blue% = ASC(MID$(temp$, 1)) \ 4π OUT &H3C8, register% 'set registerπ OUT &H3C9, red% 'set the RGB valuesπ OUT &H3C9, green%π OUT &H3C9, blue%πNEXT register%πSEEK #1, dacend& 'start of the image dataπtemp$ = SPACE$(1) 'temporary stringπFOR y% = header.height - 1 TO 0 STEP -1π 'row loopπ FOR x% = 0 TO header.widt - 1π 'column loopπ GET #1, , temp$ 'read 1 color byteπ col% = ASC(temp$) 'calculate the color valueπ DEF SEG = setseg% 'set the segmentπ CALL ABSOLUTE(x%, y%, col%, setoff%)π 'set the pixelπ DEF SEG 'reset the segmentπ NEXT x%πNEXT y%πCLOSE #1 'close the fileπCALL Waiting 'wait for a keyπDEF SEG = textseg%πCALL ABSOLUTE(textoff%) 'set the text modeπDEF SEGπCLSπENDππsetpixel:πDATA 55: 'push bpπDATA 8B,EC: 'mov bp,spπDATA 06: 'push esπDATA 8B,76,08: 'mov si,[bp+8] ;si:=address y%πDATA 8B,7E,0A: 'mov di,[bp+10] ;di:=address x%πDATA 8B,5E,06: 'mov bx,[bp+6] ;bx:=address col%πDATA B8,40,01: 'mov ax,320 ;ax:=320=bytes per rowπDATA 8B,0C: 'mov cx,[si] ;cx:=y%πDATA F7,E1: 'mul cx ;ax:=y%*320πDATA 03,05: 'add ax,[si] ;ax:=y%*320+x%πDATA 8B,F8: 'mov di,ax ;di:=ax=offset into video RAMπDATA B8,00,A0: 'mov ax,0a000H ;ax:=segment video RAMπDATA 8E,C0: 'mov es,ax ;es:di -> pixel positionπDATA 8B,07: 'mov ax,[bx] ;ax:=col%πDATA 26,88,05: 'mov byte ptr es:[di],alπ ' ;set the pixelπDATA 07: 'pop esπDATA 8B,E5: 'mov sp,bpπDATA 5D: 'pop bpπDATA CA,06,00: 'ret 6πDATA *: 'end codeπtextmode:πDATA B8,03,00: 'mov ax,0003H ;function: set text modeπDATA CD,10: 'int 10H ;transfer to BIOSπDATA CB: 'retπDATA *: 'end codeππSUB Reading (x%, y%)π DEF SEG = x% 'set the segmentπ FOR i% = 0 TO 199 'reading loopπ READ byte$ 'read 1 byteπ IF byte$ = "*" THEN EXIT FORπ 'end codeπ POKE (y% + i%), VAL("&H" + byte$)π 'write 1 byteπ NEXT i%π DEF SEG 'reset the segmentπEND SUBππSUB Waitingπ WHILE INKEY$ = ""π WENDπEND SUBπJames McMurrin MATHEMATICAL FORMULA DISPLAYED FidoNet QUIK_BAS Echo 08-28-96 (19:48) QB, QBasic, PDS 31 679 FOREST.BAS 'A basic mathematical formula dressed up in a pretty wayπ'Warning: this will take a while on slower computers!π'By: James McMurrinπCOMMON SHARED NUM AS DOUBLEπSCREEN 13πFOR PU = 1 TO 255π OUT &H3C8, PUπ OUT &H3C9, PU / 2 + 20π OUT &H3C9, PU / 4 + 10π OUT &H3C9, PU / 6 + 5πNEXT PUπFOR L = 3 TO 3.996875 STEP .003125π NUM = .5π FOR Q = 1 TO 50π NUM = NUM * L * (1 - NUM)π NEXT Qπ DOπ NUM = NUM * L * (1 - NUM)π DISROW = 200 - (NUM * 200)π P = POINT(DISCOL, DISROW)π IF P = 255 THENπ EXIT DOπ ELSEπ P = P + 1π LINE (DISCOL, DISROW)-(DISCOL, DISROW), Pπ END IFπ LOOPπ DISCOL = DISCOL + 1πNEXT LπBEEPπWHILE INKEY$ = "": WENDπTika Carr INTERRUPT TUTOR FidoNet QUIK_BAS Echo 08-03-96 (17:07) Text, QB, PDS 313 13212 INTUTOR.BAS =================================π[ QuickBasic 4.5 Tutorial ]π[ How To Use Interrupts ]π[ Copyright (c) 1996 by Tika Carr ]π =================================π(Please read disclaimer at the end of this tutorial.)ππThis tutorial hopes to cover the basics of how to use Interrupts inπQuickBasic. Note that this method only works in QuickBasic 4.5. I hopeπto do a tutorial for those who use QBasic (which comes with MS-DOS 5.0πand higher).ππ1. Getting StartedππYou will need to have started QuickBasic 4.5 by typing the followingπat the MS-DOS prompt:ππQB /L QB.QLBππThis QuickLiBrary will load in what you need to use interrupts.ππMany new programmers avoid using interrupts because they are afraid toπdamage their computer. I've noticed people mess up thier systemπ*without* using interrupts. Sections 7 - 9 have some tips on safeπdebugging and what to do if you have a crash. Further, BACK UP YOURπHARD DRIVES! This is MOST important! And save your programs ontoπfloppy diskette before you run them. Ultimately, its still up to youπto protect your system. This goes for any type of programming.ππ2. Your First InterruptππType in the following and save it, then run it. We'll look at theπprogram and see how it all works in a moment.ππ=======>8 Snip 8<=======ππ'Example Program for CALL INTERRUPT Tutorialπ'by Tika Carrππ'$INCLUDE: 'QB.BI'ππDIM Inregs AS RegType, Outregs AS RegTypeππ'Int 10h (interrupt 10 hexidecimal) controls the video part.π'0Ah tells the computer to write a character on the screen.π'We'll put the letter 'A' on the screen in this example.ππCLSππInregs.ax = &HA41 'load high and low bytes into ax register (&H0A01)πInregs.cx = 1 'write only 1 characterππCALL INTERRUPT(&H10, Inregs, Outregs) 'put the character on the screenππ=======>8 Snip 8<=======ππ'$INCLUDE: 'QB.BI' defines the type structures used for theπinterrupts.ππDIM Inregs AS RegType, Outregs AS RegTypeππThe INCLUDE statement defines the type structures that is used forπinterrupts. These are found in the QB.BI file that comes withπQuickBasic 4.5. The DIM Statement lets you specify what variable toπput the registers defined in RegType in, so that its easy to pass allπthe registers to the interrupt.ππ3. What are registeres and what do they do?ππA register is a place where you store values, and is a more direct wayπto communicate with the computer. The computer looks into registersπfor specific values, and uses them to perform different tasks. Forπexample, we gave the computer some information in the AX register,πtelling it we wanted to write something on the screen, and what weπwanted to write to the screen (the letter 'A'). We also put a valueπinto the CX register, telling the computer we wanted to write only oneπcopy of the letter 'A'. When you call an interrupt, you send all thatπinformation along to the computer (int 10h, which accesses yourπvideo). Basically, we just told the computer to PRINT "A" on theπscreen. Registers also let the computer send information back to yourπprogram. For example, INT 33 can give your program the X and Yπcoordinates of where the mouse currently is located.ππFor CALL INTERRUPT: ax, bx, cx, dx, bp, si, di, flagsπDefined as RegTypeππFOR CALL INTERRUPTX: ax, bx, cx, dx, bp, si, di, flags, ds, esπDefined as RegTypeXππDepending on the interrupt you want to use, you will need to pick theπtype of call that suits it. For instance, if you don't use the esπregister, then using CALL INTERRUPT would work fine. However, if theπcomputer will be looking into the es register for something, or if youπwill need to know what is in the ds register, you will want to use theπCALL INTERRUPTX.ππThese definitions are all in the QB.BI file. You '$INCLUDE: 'QB.BI' inπyour program, then you DIM Inregs AS RegyType, OutRegs AS RegType.πThese will set up your variables so that you can access the registers.ππTo put something into the registers, you use Inregs, and to read theπregisters, you use the OutRegs variable:ππInregs.ax is where you would put something in the AX register.πOutregs.cx is where you can find what the computer put in the CXπ register.ππ4. Storing Values into Registers:ππSince the registers take information in bytes only, you may have to doπsome converting to load the registers properly. Many times anπinterrupt listing will show something like:ππInterrupt 10h: Videoπ Entry: ah = 0A write a character to the screenπ al = value of character to writeπ bh = video pageπ bl = attribute or color of characterπ cx = number of times to write the characterππThis can seem confusing. How do you load the AX register? Where IS it?πThere's an AH and an AL. These mean the High and Low bytes of the AXπregister, respectively. Here's how you would put a value into the AXπregister:ππInregs.ax = &HA41 'load high and low bytes into ax register (&H0A01)ππ(Note that QuickBasic likes to take away the leading 0s. Initially, weπtyped it as: Inregs.ax = &H0A41)ππThe values go into the registers as: 0A41π HiLoππMost of the time, you probably will run into this situation:ππVideo$ = "0A" ' Tell computer to write to videoπCharacter$ = "A" ' Character to write on screenππHere is how you would get it all into one register:ππCharacter$ = HEX$(ASC(A)) ' Convert 'A' into its ASCII value inπ ' Hexidecimal.ππSince Video$ already is in Hexidecimal, we won't need to change it.πNow, we put them together:ππAX$ = Video$ + Character$ ' AX$ now contains 0A41 PRINT AX$ toπ ' see for yourself.ππNow that we got the full hexidecimal value to put into the AXπregister, we still have to convert this into a *number*:ππInregs.ax = VAL("&H" + AX$)ππThis makes the string now say "&H0A41" and it also converts it into aπnumeric value (using VAL). Now you have the high and low bytesπconverted and stored into the AX register that will go into theπcomputer (Inregs). When you do the CALL INTERRUPT (&H10, Inregs,πOutregs), the values will be correctly loaded where the computer canπfind them.ππ5. Reading the RegistersππOutregs also holds register values. After you make a CALL INTERRUPT,πyou can read, let's say, the high and low bytes of the BX register andπuse it in your own program:ππBX$ = HEX$(Outregs.bx) ' Convert the value to hexidecimal, itsπ ' easier to extract the high and low bytesπ ' this way.ππSince the computer likes to truncate leading 0s, we have to convertπthe value of BX$:ππ' Get Low and High Byte of BXπ' BH$ is the high byte, BL$ is the low byte, both in Hexidecimal.ππL = LEN(BX$)πIF L = 1 THEN BH$ = "0" + BX$: BL$ = "00"πIF L = 2 THEN BH$ = LEFT$(BX$, 2): BL$ = "00"πIF L = 3 THEN BH$ = "0" + LEFT$(BX$, 1): BL$ = RIGHT$(BX$, 2)πIF L = 4 THEN BH$ = LEFT$(BX$, 1): BL$ = RIGHT$(BX$, 2)ππbh = VAL("&H" + BH$) ' Decimal Value of high byte of BXπbl = VAL("&H" + BL$) ' Decimal Value of low byte of BXππNote that this is only applicable for any register you need to getπspecifically the low and high bytes of. Sometimes a register is aπpointer to a memory address. If that is the case, you can just useπthat value directly, without any type of conversion. For example:ππAddress = Outregs.esπValue = Outregs.dxπPOKE Address, Valueπ' Or do whatever you need to with the address returned.ππ6. Calling the InterruptππWhen you do a CALL INTERRUPT you access a certain function within theπcomputer. For example, in CALL INTERRUPT(&H10, Inregs, Outregs) youπcalled the video interrupt 10h (&H10). Its best of course, to knowπwhat interrupt does what, what to put into the registers, and what theπregisters may return to your program that you may be able to use. Theπbest Interrupt source I've found is Ralph Brown's Interrupt List,πfound on some programming BBSs and on the internet on different FTPπsites (like Oakland, SimTel, and Garbo, which you can get currentπaddresses for by searching Lycos at http://lycos.cs.cmu.edu)ππ7. What To Do About Crashesππa) BACKUP YOUR PROGRAMS BEFORE RUNNING THEM!πFirst and foremost, its good practice to save your program onto aπfloppy diskette before you run it. When your system crashes and youπget back in, just reload the program into QuickBasic.ππb) System CrashesπIf your system crashes, or seems to hang, first try hitting CTRL-C orπCTRL-Pause (which is also CTRL-Break). You may have to hit ENTERπafterward to get back to the QuickBasic Interactive Debugging Editorπ(IDE) to look at your program. If this don't work, reboot the computerπwith CTRL-ALT-DEL (or hit the RESET button on the computer if thatπdidn't work). Then reload and take a look at your program. If worseπcomes to worse, you can shut off the computer, wait a few moments andπturn it back on. Personally, I have always been able to recover byπbreaking out of the program with CTRL-Break.ππc) Disk FAT crashesπThis is one situation that could occur if you are using interrupts toπaccess the disk drives or hard disk, and you didn't get things loadedπin right. Best to have your hard drive backed up before eachπprogramming session if you know you'll be using interrupts that willπaccess the disk drives (ie. may have potential of writing to sectorsπor the FAT). Another good thing to have on hand is some utilities thatπrepair damaged FAT tables and such. There are a number of goodπcommercial programs out there, and some shareware ones as well. Putπone of these on a bootable floppy.ππd) Video, Sound and other hardwareπIts rare that you can actually damage hardware with an interupt call.πIf something goes "haywire" the best bet is to just hit the resetπbutton on the PC right away. Usually, things will then reset andπrecover.ππ8. Safe DebuggingππOnce you get your program written, put a remark before the CALLπINTERRUPT:ππ'CALL INTERRUPT (&H10, Inregs, Outregs)ππThen set up the Debug to watch your variables:ππHEX$(Inregs.ax)πHEX$(Outresg.bx)ππOr whatever variables you are working with. Then ALT-R R to restart.πNOW SAVE THE PROGRAM TO FLOPPY DISK! Remove the disk from the drive.πHit F8 to step through your program one instruction at a time, payingπclose attention to the values in the variables. Are they loadingπproperly? Once you think its working, you can again save the programπand then remove the remark from the call. Step through again and payπattention to the Outregs registers if you are using them.ππIt may seem like a lot to go through, but watching how your programπworks step by step, especially if you're first learning to useπinterrupts, will show you how the computer uses them, and how yourπprograms behave (for better or for worse).ππ9. In Closing....ππInterrupts are a great way to do things in QuickBasic that you can'tπfind a command for. Normally, they don't hurt anything and at worse,πjust make you have to restart the computer. While a risk is there toπmess up things like hard drives, its rare you'll run into that, if atπall, as long as you don't use disk interrupts until you areπcomfortable with how interrupts work and how to use them. Stick withπwriting for video, mouse, printer, sound card for starters. Video isπeasiest, as is the mouse. And if wierd things happen, don't panic -πreset. :)ππ ******* DISCLAIMER *******ππThe author of this article cannot garantee the usability orπsuitability of the inforamtion presented herein for any particularπpurpose. In addition, the user of the information in this articleπagrees not to hold the author, moderator or any other direct orπindirect agent liable in any way for any damages, loss of data, orπother consequenses arising from use of this information. While I haveπmade every conscious effort to ensure the information in this tutorialπis accurate and safe to use on any PC compatible in the QuickBasic 4.5πenvironment, the end result depends on the person making use of theπintformation presented here. Use the information in this tutorial atπyour own risk.ππ ******* CONTACT INFORMATION *******ππAs of 8/3/96, comments, questions and suggestions, can be directed to:ππ FidoNet: Tika Carr 1:2613/601πInternet: kari@rochgte.fidonet.orgππ=====================================================================πTika Carr, former staff writer and later editor of GEnieLamp PCπMultimedia Magazine, has been writing QuickBasic 4.5 programs sinceπ1989, and is a frequent contributor to the QUICK_BAS FidoNet Echo. Herπarea of specialty is in "tools that make tools" (Steven Levy,π"Hackers"), meaning anything that will make things easier forπprogrammers to take control of the computer, and make theirπimaginations come alive.π=====================================================================πMicrosoft, QuickBasic 4.5, and QBasic are trademarks of MicrosoftπCorporation. MS-DOS is a registered trademark of MicrosoftπCorporation.πRichard J. Backus INTERRUPTS IN QBASIC FidoNet QUIK_BAS Echo 12-27-95 (00:00) QBasic 139 5942 BASICDOS.BAS'Thought I'd repost this as its been awhile since I last posted:ππ'A tutorial for Richard Backus' BASICDOS.BAS code. Here isπ'the code in the original form that he sent to me:ππ'===========>8 CLIP 8<============ππ' BASICDOS.BASπ' written: Richard J Backus 27dec95π' purpose: to provide a BASIC BIOS/DOS call interfaceπ' method: using the CALL interface, get registers, call the interrupt, andπ' return the registers. Based on QuickBasic's CALL INTERRUPT routine.π' Warning: Calls requiring segment registers cannot be used.ππ' QBasic syntax: CALL ABSOLUTE(intnum%, callregs, retregs, VARPTR(asmcode)))π' intnum% a valid DOS interrupt number between 0 and 255, type INTEGERπ' callregs register values required by call, type REGSπ' retregs register values returned from call, type REGSπTYPE REGS 'Typedef for DOS registersπ ax AS INTEGERπ bx AS INTEGERπ cx AS INTEGERπ dx AS INTEGERπ bp AS INTEGERπ si AS INTEGERπ di AS INTEGERπ flg AS INTEGERπEND TYPEπ' DOS call codeπDATA &H55, &H06, &H1E, &H8B, &HEC, &H9C, &H8B, &H7E, &H0E, &H8AπDATA &H05, &H8B, &H7E, &H0C, &HB4, &H35, &HCD, &H21, &H8B, &H46πDATA &HF8, &H05, &H20, &H00, &H0E, &H50, &H06, &H53, &H8B, &H05πDATA &H8B, &H5D, &H02, &H8B, &H4D, &H04, &H8B, &H55, &H06, &H8BπDATA &H6D, &H08, &H8B, &H75, &H0A, &H8B, &H7D, &H0C, &HFA, &HCBπDATA &H1F, &H07, &H57, &H9C, &H8B, &HFC, &H36, &H8B, &H7D, &H0AπDATA &H89, &H05, &H89, &H5D, &H02, &H89, &H4D, &H04, &H89, &H55πDATA &H06, &H89, &H6D, &H08, &H89, &H75, &H0A, &H58, &H89, &H45πDATA &H0E, &H58, &H89, &H45, &H0C, &H5D, &HCA, &H06, &H00π' Load DOS/BIOS interface routineπDIM dos%(45) 'get some memory spaceπDEF SEG = VARSEG(dos%(0))πFOR i% = 0 TO 88π READ d%π POKE VARPTR(dos%(0))+i%, d% 'copy code into memoryπNEXT i%ππ' Message stringπDATA &H48, &H65, &H6C, &H6C, &H6F, &H20, &H57, &H6F, &H72, &H6CπDATA &H64, &H0D, &H0Aπ' use DOS to output the messageπDIM dosregs AS REGSπFOR i% = 0 TO 12π intnum% = &H21 'parameters for callπ dosregs.ax% = &H200π READ dosregs.dx%π DEF SEG = VARSEG(dos%(0)) 'set call segπ CALL ABSOLUTE(intnum%, dosregs, dosregs, VARPTR(dos%(0)))πNEXT i%πENDππ'=============>8 CLIP 8<================ππ'TYPE REGS will set up the variable REGS to access all the registersπ'you need to make a BIOS call. This goes in hand with teh DIM dosregsπ'as REGS. Dosregs will contain the information of the registers. Forπ'example, if you want to send a value to the AX register, you can setπ'dosregs.ax=value. I'm not great at explaining how TYPE works, so bestπ'consult some books (or the help file) on that one. :)ππ'Next he has his assembly routine that emulates CALL INTERRUPT. Thisπ'and the code under it that pokes the routine into memory is the heartπ'of the whole thing.ππ'Next, he creates the data for each character in the string "Helloπ'World" and he uses a BIOS video call to place each character on theπ'screen (much the same way my GPrint routine does in my GUI interface).π'π'Note how he used CALL ABSOLUTE. Lets compare it with QB45's CALLπ'INTERRUPT syntax:ππ'QB45: CALL INTERRUPT (intnum%, dosregs, dosregs)π'QBASIC: CALL ABSOLUTE (intnum%, dosregs, dosregs, VARPTR(dos%(0)))ππ'Notice all is basically the _same_, you just add the VARPTR at theπ'end! And don't forget to change INTERRUPT to ABSOLUTE. This makes itπ'very easy to change a QB45 code to work with QBasic.ππ'Now, I will try and explain how you can convert QB45 code that usesπ'CALL INTERRUPT so that it will work in QBasic. Of course, you'll needπ'the code written by Richard Backus (which was posted in the previousπ'message). Also note this works only for the CALL INTERRUPT calls. Ifπ'you see CALL INTERRUPTX or CALL INT86, I'm not sure how it will workπ'with those, as they take slightly different parameters.ππ'First off, the QB45 program will have a '$INCLUDE statemtent in it.π'You must delete that statement. Next, put the TYPE REGS in AFTER theπ'DECLARE SUB and DECLARE FUNCTION statements (if any). You'll want toπ'more than likely change REGS to RegType, as that is what the qb.bi wasπ'using. This will replace it.ππ'Now, put the DIM SHARED Inregs as RegType, Outregs as RegType with theπ'DIM statements, if there isn't one there already. Most often thanπ'not, it may not need changing. Also add in DIM SHARED dos%(45) andπ'DEF SEG = VARSEG(dos%(0)). It should look something like this:ππ'DIM and CONST, etc. hereπ'DIM SHARED Inregs as RegType, Outregs as RegTypeπ'DIM SHARED dos%(45)π'DEF SEG = VARSEG(dos%(0))ππ'Once you have the variables all set up, next slip the DOS Call Codeπ'data statements and teh Load DOS/BIOS interface routine just beforeπ'the main code of the program starts. Most of the time, there's a CLSπ'or SCREEN statement there.ππ'Now just one more step. Look through the code (may want to do aπ'search for CALL INTERRUPT). You will need to change each occurance ofπ'INTERRUPT to ABSOLUTE. And, you will need to add to the end of eachπ'CALL ABSOLUTE (which was a CALL INTERRUPT) the VARPTR statement. Forπ'example, suppose the QB45 code read:ππ' CALL INTERRUPT (intnum%, Inregs, Outregs)ππ'You would change it to read:ππ' CALL ABSOLUTE (intnum%, Inregs, Outregs, VARPTR(dos%(0)))ππ'Be sure to get all the parenthesis right! There's _3_ of them at theπ'end of the ABSOLUTE statement (I say this because I'm bad at it andπ'forget alot! :)ππ'Now you can save the new code to a new file name (for safe keeping)π'and run it. It should work!ππ'If you have any questions, let me know. I can't promise I'll be ableπ'to have an answer every time but I'll try. If you need to contactπ'Richard, net mail me and I'll forward your question or whatever toπ'him. Just a short note that he does most of his programming inπ'assembly. :)πChris Sugden LIBERTY YAHTZEE csugden@thecafe.co.uk 07-10-96 (20:53) LB 973 34265 YAHTZEE.BAS [Start]πprint " | | | | | ||||||||||||||| |||||||||| ||||||||| ||||||||||"πprint " | | | | | | | | | | "πprint " | | | | | | | | | | "πprint " | | | | | | | | | | "πprint " | | | | | | | | | | "πprint " | | | | |||||||||||| | | ||||||||| ||||||||||"πprint " | ||||||||||| | | | | | | "πprint " | | | | | | | | | "πprint " | | | | | | | | | "πprint " | | | | | | | | | "πprint " | | | | | | | | | "πprint " | | | | | | |||||||||| ||||||||| ||||||||||"πprint ""πprint ""πinput "Do you want to read some brief rules?";readrules$πif instr("YESYesyes",readrules$) > 0 then goto [Rules]πprint ""πinput "Press Enter to continue";enterπif enter = 0 then goto [RollDice]ππ[RollDice]πlet Reroll = 0πlet Count = Count + 1πlet Turns = Count - 1πclsπlet total = acestotal + twostotal + threestotal + fourstotal + fivestotal + sixestotal + threescore + fourscore + FullScore + LowScore + highScore + Yatzeescore + DiceSumπprint "After ";Turns;" turns, your score is ";total;"."πprint ""πprint "Dice being rolled..."πgoto [Dice1]ππ[Dice1]πlet Dice1 = int(rnd(1)*6)+1πgoto [Dice2]ππ[Dice2]πlet Dice2 = int(rnd(1)*6)+1πgoto [Dice3]ππ[Dice3]πlet Dice3 = int(rnd(1)*6)+1πgoto [Dice4]ππ[Dice4]πlet Dice4 = int(rnd(1)*6)+1πgoto [Dice5]ππ[Dice5]πlet Dice5 = int(rnd(1)*6)+1πgoto [Choose]ππ[Choose]πprint "OK. This is how the dice came out:"πprint "Dice 1 came up as ";Dice1;"."πprint "Dice 2 came up as ";Dice2;"."πprint "Dice 3 came up as ";Dice3;"."πprint "Dice 4 came up as ";Dice4;"."πprint "Dice 5 came up as ";Dice5;"."πprint ""πinput "Do you want to reroll any of the dice?";reroll$πif instr("YESYesyes",reroll$) > 0 then goto [Reroll]πgoto [Score]ππ[Score]πprint "You have a choice of how you want to score."πprint ""πprint "You can do:"πprint "Aces, Twos, Threes, Fours, Fives, Sixes,"πprint "3 Of A Kind, 4 Of A Kind, Full House, Low Straight,"πprint "High Straight, Yahtzee or Chance."πprint ""πinput "Do you want help on any of the scoring possibilities?";help$πif instr("YESYesyes",help$) > 0 then goto [Help]πgoto [ChooseScore]ππ[ChooseScore]πinput "DO YOU WANT TO CONTINUE?";continue$πif instr("NOnoNo",continue$) > 0 then goto [Bonus]πprint "So how are you going to score?"πprint ""πprint "Please type in the first word or number of each scoring"πinput "possibility, such as '3' for '3 Of A Kind'.";score$πgoto [ChooseAces]ππ[ChooseAces]πif instr("ACESacesAces",score$) > 0 then goto [Aces]πgoto [ChooseTwos]ππ[ChooseTwos]πif instr("TWOSTwostwos",score$) > 0 then goto [Twos]πgoto [ChooseThrees]ππ[ChooseThrees]πif instr("THREESThreesthrees",score$) > 0 then goto [Threes]πgoto [ChooseFours]ππ[ChooseFours]πif instr("FOURSfoursFours",score$) > 0 then goto [Fours]πgoto [ChooseFives]ππ[ChooseFives]πif instr("FivesfivesFIVES",score$) > 0 then goto [Fives]πgoto [ChooseSixes]ππ[ChooseSixes]πif instr("SIXESsixesSixes",score$) > 0 then goto [Sixes]πgoto [Choose3OfAKind]ππ[Choose3OfAKind]πif instr("3",score$) > 0 then goto [3OfAKind]πgoto [Choose4OfAKind]ππ[Choose4OfAKind]πif instr("4",score$) > 0 then goto [4OfAKind]πgoto [ChooseFullHouse]ππ[ChooseFullHouse]πif instr("FullFullfull",score$) > 0 then goto [FullHouse]πgoto [ChooseLowStraight]ππ[ChooseLowStraight]πif instr("LOWlowLow",score$) > 0 then goto [LowStraight]πgoto [ChooseHighStraight]ππ[ChooseHighStraight]πif instr("HIGHHighhigh",score$) > 0 then goto [HighStraight]πgoto [ChooseYahtzee]ππ[ChooseYahtzee]πif instr("YAHTZEEYahtzeeyahtzee",score$) > 0 then goto [Yahtzee]πgoto [ChooseChance]ππ[ChooseChance]πif instr("CHANCEChancechance",score$) > 0 then goto [Chance]πgoto [Unknown]ππ[Unknown]πclsπprint "There is no such scoring possibility!"πprint "Try again."πprint ""πgoto [ChooseScore]ππ[Aces]πlet AcesCount = AcesCount + 1πif AcesCount > 1 then goto [AlreadyChosen]πif Dice1 = 1 then let total = total + 1πif Dice2 = 1 then let total = total + 1πif Dice3 = 1 then let total = total + 1πif Dice4 = 1 then let total = total + 1πif Dice5 = 1 then let total = total + 1πif Dice1 = 1 then let acestotal = acestotal + 1πif Dice2 = 1 then let acestotal = acestotal + 1πif Dice3 = 1 then let acestotal = acestotal + 1πif Dice4 = 1 then let acestotal = acestotal + 1πif Dice5 = 1 then let acestotal = acestotal + 1πprint "That turn you won ";acestotal;" points."πinput "Press Enter to continue";enter1πgoto [RollDice]ππ[Twos]πlet TwosCount = TwosCount + 1πif TwosCount > 1 then goto [AlreadyChosen]πif Dice1 = 2 then let total = total + 2πif Dice2 = 2 then let total = total + 2πif Dice3 = 2 then let total = total + 2πif Dice4 = 2 then let total = total + 2πif Dice5 = 2 then let total = total + 2πif Dice1 = 2 then let twostotal = twostotal + 2πif Dice2 = 2 then let twostotal = twostotal + 2πif Dice3 = 2 then let twostotal = twostotal + 2πif Dice4 = 2 then let twostotal = twostotal + 2πif Dice5 = 2 then let twostotal = twostotal + 2πprint "That turn you won ";twostotal;" points."πinput "Press Enter to continue";enter2πgoto [RollDice]ππ[Threes]πlet ThreesCount = ThreesCount + 1πif ThreesCount > 1 then goto [AlreadyChosen]πif Dice1 = 3 then let total = total + 3πif Dice2 = 3 then let total = total + 3πif Dice3 = 3 then let total = total + 3πif Dice4 = 3 then let total = total + 3πif Dice5 = 3 then let total = total + 3πif Dice1 = 3 then let threestotal = threestotal + 3πif Dice2 = 3 then let threestotal = threestotal + 3πif Dice3 = 3 then let threestotal = threestotal + 3πif Dice4 = 3 then let threestotal = threestotal + 3πif Dice5 = 3 then let threestotal = threestotal + 3πprint "That turn you won ";threestotal;" points."πinput "Press Enter to continue";enter3πgoto [RollDice]ππ[Fours]πlet FoursCount = FoursCount + 1πif FoursCount > 1 then goto [AlreadyChosen]πif Dice1 = 4 then let total = total + 4πif Dice2 = 4 then let total = total + 4πif Dice3 = 4 then let total = total + 4πif Dice4 = 4 then let total = total + 4πif Dice5 = 4 then let total = total + 4πif Dice1 = 4 then let fourstotal = fourstotal + 4πif Dice2 = 4 then let fourstotal = fourstotal + 4πif Dice3 = 4 then let fourstotal = fourstotal + 4πif Dice4 = 4 then let fourstotal = fourstotal + 4πif Dice5 = 4 then let fourstotal = fourstotal + 4πprint "That turn you won ";fourstotal;" points."πinput "Press Enter to continue";enter4πgoto [RollDice]ππ[Fives]πlet FivesCount = FivesCount + 1πif FivesCount > 1 then goto [AlreadyChosen]πif Dice1 = 5 then let total = total + 5πif Dice2 = 5 then let total = total + 5πif Dice3 = 5 then let total = total + 5πif Dice4 = 5 then let total = total + 5πif Dice5 = 5 then let total = total + 5πif Dice1 = 5 then let fivestotal = fivestotal + 5πif Dice2 = 5 then let fivestotal = fivestotal + 5πif Dice3 = 5 then let fivestotal = fivestotal + 5πif Dice4 = 5 then let fivestotal = fivestotal + 5πif Dice5 = 5 then let fivestotal = fivestotal + 5πprint "That turn you won ";fivestotal;" points."πinput "Press Enter to continue";enter4πgoto [RollDice]ππ[Sixes]πlet SixesCount = SixesCount + 1πif SixesCount > 1 then goto [AlreadyChosen]πif Dice1 = 6 then let total = total + 6πif Dice2 = 6 then let total = total + 6πif Dice3 = 6 then let total = total + 6πif Dice4 = 6 then let total = total + 6πif Dice5 = 6 then let total = total + 6πif Dice1 = 6 then let sixestotal = sixestotal + 6πif Dice2 = 6 then let sixestotal = sixestotal + 6πif Dice3 = 6 then let sixestotal = sixestotal + 6πif Dice4 = 6 then let sixestotal = sixestotal + 6πif Dice5 = 6 then let sixestotal = sixestotal + 6πprint "That turn you won ";sixestotal;" points."πinput "Press Enter to continue";enter4πgoto [RollDice]ππ[3OfAKind]πlet threeOfCount = threeOfCount + 1πif threeOfCount > 1 then goto [AlreadyChosen]πif Dice1 = Dice2 then goto [3OK12]πif Dice1 = Dice3 then goto [3OK13]πif Dice1 = Dice4 then goto [3OK14]πif Dice1 = Dice5 then goto [3OK15]πif Dice2 = Dice3 then goto [3OK23]πif Dice2 = Dice4 then goto [3OK24]πif Dice2 = Dice5 then goto [3OK25]πif Dice3 = Dice4 then goto [3OK34]πif Dice3 = Dice5 then goto [3OK35]πif Dice4 = Dice5 then goto [3OK45]πgoto [NO3OF]ππ[NO3OF]πprint "Sorry, you don't have 3 Of A Kind."πprint "Try again."πprint ""πgoto [Choosescore]ππ[3OK12]πif Dice1 = Dice3 then goto [OK3]πif Dice1 = Dice4 then goto [OK3]πif Dice1 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK13]πif Dice1 = Dice2 then goto [OK3]πif Dice1 = Dice4 then goto [OK3]πif Dice1 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK14]πif Dice1 = Dice2 then goto [OK3]πif Dice1 = Dice3 then goto [OK3]πif Dice1 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK15]πif Dice1 = Dice2 then goto [OK3]πif Dice1 = Dice3 then goto [OK3]πif Dice1 = Dice4 then goto [OK3]πgoto [NO3OF]ππ[3OK23]πif Dice2 = Dice1 then goto [OK3]πif Dice2 = Dice4 then goto [OK3]πif Dice2 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK24]πif Dice2 = Dice3 then goto [OK3]πif Dice2 = Dice1 then goto [OK3]πif Dice2 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK25]πif Dice2 = Dice1 then goto [OK3]πif Dice2 = Dice3 then goto [OK3]πif Dice2 = Dice4 then goto [OK3]πgoto [NO3OF]ππ[3OK34]πif Dice3 = Dice1 then goto [OK3]πif Dice3 = Dice2 then goto [OK3]πif Dice3 = Dice5 then goto [OK3]πgoto [NO3OF]ππ[3OK35]πif Dice3 = Dice1 then goto [OK3]πif Dice3 = Dice2 then goto [OK3]πif Dice3 = Dice4 then goto [OK3]πgoto [NO3OF]ππ[3OK45]πif Dice4 = Dice1 then goto [OK3]πif Dice4 = Dice2 then goto [OK3]πif Dice4 = Dice3 then goto [OK3]πgoto [NO3OF]ππ[OK3]πlet threescore = Dice1 + Dice2 + Dice3 + Dice4 + Dice5πprint "That turn you won ";threescore;" points."πinput "Press Enter to continue";enter5πgoto [RollDice]ππ[4OfAKind]πlet fourOfCount = fourOfCount + 1πif fourOfCount > 1 then goto [AlreadyChosen]πlet AllDice$ = "";Dice1;"";Dice2;"";Dice3;"";Dice4;"";Dice5;""πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"21111") > 0 then goto [OK4]πif instr(AllDice$,"31111") > 0 then goto [OK4]πif instr(AllDice$,"41111") > 0 then goto [OK4]πif instr(AllDice$,"51111") > 0 then goto [OK4]πif instr(AllDice$,"61111") > 0 then goto [OK4]πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"12111") > 0 then goto [OK4]πif instr(AllDice$,"13111") > 0 then goto [OK4]πif instr(AllDice$,"14111") > 0 then goto [OK4]πif instr(AllDice$,"15111") > 0 then goto [OK4]πif instr(AllDice$,"16111") > 0 then goto [OK4]πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"11211") > 0 then goto [OK4]πif instr(AllDice$,"11311") > 0 then goto [OK4]πif instr(AllDice$,"11411") > 0 then goto [OK4]πif instr(AllDice$,"11511") > 0 then goto [OK4]πif instr(AllDice$,"11611") > 0 then goto [OK4]πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"11121") > 0 then goto [OK4]πif instr(AllDice$,"11131") > 0 then goto [OK4]πif instr(AllDice$,"11141") > 0 then goto [OK4]πif instr(AllDice$,"11151") > 0 then goto [OK4]πif instr(AllDice$,"11161") > 0 then goto [OK4]πif instr(AllDice$,"11111") > 0 then goto [OK4]πif instr(AllDice$,"11112") > 0 then goto [OK4]πif instr(AllDice$,"11113") > 0 then goto [OK4]πif instr(AllDice$,"11114") > 0 then goto [OK4]πif instr(AllDice$,"11115") > 0 then goto [OK4]πif instr(AllDice$,"11116") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"32222") > 0 then goto [OK4]πif instr(AllDice$,"42222") > 0 then goto [OK4]πif instr(AllDice$,"52222") > 0 then goto [OK4]πif instr(AllDice$,"62222") > 0 then goto [OK4]πif instr(AllDice$,"12222") > 0 then goto [OK4]πif instr(AllDice$,"21222") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"23222") > 0 then goto [OK4]πif instr(AllDice$,"24222") > 0 then goto [OK4]πif instr(AllDice$,"25222") > 0 then goto [OK4]πif instr(AllDice$,"26222") > 0 then goto [OK4]πif instr(AllDice$,"22122") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"22322") > 0 then goto [OK4]πif instr(AllDice$,"22422") > 0 then goto [OK4]πif instr(AllDice$,"22522") > 0 then goto [OK4]πif instr(AllDice$,"22622") > 0 then goto [OK4]πif instr(AllDice$,"22212") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"22232") > 0 then goto [OK4]πif instr(AllDice$,"22242") > 0 then goto [OK4]πif instr(AllDice$,"22252") > 0 then goto [OK4]πif instr(AllDice$,"22262") > 0 then goto [OK4]πif instr(AllDice$,"22221") > 0 then goto [OK4]πif instr(AllDice$,"22222") > 0 then goto [OK4]πif instr(AllDice$,"22223") > 0 then goto [OK4]πif instr(AllDice$,"22224") > 0 then goto [OK4]πif instr(AllDice$,"22225") > 0 then goto [OK4]πif instr(AllDice$,"22226") > 0 then goto [OK4]πif instr(AllDice$,"13333") > 0 then goto [OK4]πif instr(AllDice$,"23333") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"43333") > 0 then goto [OK4]πif instr(AllDice$,"53333") > 0 then goto [OK4]πif instr(AllDice$,"63333") > 0 then goto [OK4]πif instr(AllDice$,"31333") > 0 then goto [OK4]πif instr(AllDice$,"32333") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"34333") > 0 then goto [OK4]πif instr(AllDice$,"35333") > 0 then goto [OK4]πif instr(AllDice$,"36333") > 0 then goto [OK4]πif instr(AllDice$,"33133") > 0 then goto [OK4]πif instr(AllDice$,"33233") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"33433") > 0 then goto [OK4]πif instr(AllDice$,"33533") > 0 then goto [OK4]πif instr(AllDice$,"33633") > 0 then goto [OK4]πif instr(AllDice$,"33313") > 0 then goto [OK4]πif instr(AllDice$,"33323") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"33343") > 0 then goto [OK4]πif instr(AllDice$,"33353") > 0 then goto [OK4]πif instr(AllDice$,"33363") > 0 then goto [OK4]πif instr(AllDice$,"33331") > 0 then goto [OK4]πif instr(AllDice$,"33332") > 0 then goto [OK4]πif instr(AllDice$,"33333") > 0 then goto [OK4]πif instr(AllDice$,"33334") > 0 then goto [OK4]πif instr(AllDice$,"33335") > 0 then goto [OK4]πif instr(AllDice$,"33336") > 0 then goto [OK4]πif instr(AllDice$,"14444") > 0 then goto [OK4]πif instr(AllDice$,"24444") > 0 then goto [OK4]πif instr(AllDice$,"34444") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"54444") > 0 then goto [OK4]πif instr(AllDice$,"64444") > 0 then goto [OK4]πif instr(AllDice$,"41444") > 0 then goto [OK4]πif instr(AllDice$,"42444") > 0 then goto [OK4]πif instr(AllDice$,"43444") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"45444") > 0 then goto [OK4]πif instr(AllDice$,"46444") > 0 then goto [OK4]πif instr(AllDice$,"44144") > 0 then goto [OK4]πif instr(AllDice$,"44244") > 0 then goto [OK4]πif instr(AllDice$,"44344") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"44544") > 0 then goto [OK4]πif instr(AllDice$,"44644") > 0 then goto [OK4]πif instr(AllDice$,"44414") > 0 then goto [OK4]πif instr(AllDice$,"44424") > 0 then goto [OK4]πif instr(AllDice$,"44434") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"44454") > 0 then goto [OK4]πif instr(AllDice$,"44464") > 0 then goto [OK4]πif instr(AllDice$,"44441") > 0 then goto [OK4]πif instr(AllDice$,"44442") > 0 then goto [OK4]πif instr(AllDice$,"44443") > 0 then goto [OK4]πif instr(AllDice$,"44444") > 0 then goto [OK4]πif instr(AllDice$,"44445") > 0 then goto [OK4]πif instr(AllDice$,"44446") > 0 then goto [OK4]πif instr(AllDice$,"15555") > 0 then goto [OK4]πif instr(AllDice$,"25555") > 0 then goto [OK4]πif instr(AllDice$,"35555") > 0 then goto [OK4]πif instr(AllDice$,"45555") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"65555") > 0 then goto [OK4]πif instr(AllDice$,"51555") > 0 then goto [OK4]πif instr(AllDice$,"52555") > 0 then goto [OK4]πif instr(AllDice$,"53555") > 0 then goto [OK4]πif instr(AllDice$,"54555") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"56555") > 0 then goto [OK4]πif instr(AllDice$,"55155") > 0 then goto [OK4]πif instr(AllDice$,"55255") > 0 then goto [OK4]πif instr(AllDice$,"55355") > 0 then goto [OK4]πif instr(AllDice$,"55455") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"55655") > 0 then goto [OK4]πif instr(AllDice$,"55515") > 0 then goto [OK4]πif instr(AllDice$,"55525") > 0 then goto [OK4]πif instr(AllDice$,"55535") > 0 then goto [OK4]πif instr(AllDice$,"55545") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"55565") > 0 then goto [OK4]πif instr(AllDice$,"55551") > 0 then goto [OK4]πif instr(AllDice$,"55552") > 0 then goto [OK4]πif instr(AllDice$,"55553") > 0 then goto [OK4]πif instr(AllDice$,"55554") > 0 then goto [OK4]πif instr(AllDice$,"55555") > 0 then goto [OK4]πif instr(AllDice$,"55556") > 0 then goto [OK4]πif instr(AllDice$,"16666") > 0 then goto [OK4]πif instr(AllDice$,"26666") > 0 then goto [OK4]πif instr(AllDice$,"36666") > 0 then goto [OK4]πif instr(AllDice$,"46666") > 0 then goto [OK4]πif instr(AllDice$,"56666") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πif instr(AllDice$,"61666") > 0 then goto [OK4]πif instr(AllDice$,"62666") > 0 then goto [OK4]πif instr(AllDice$,"63666") > 0 then goto [OK4]πif instr(AllDice$,"64666") > 0 then goto [OK4]πif instr(AllDice$,"65666") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πif instr(AllDice$,"66166") > 0 then goto [OK4]πif instr(AllDice$,"66266") > 0 then goto [OK4]πif instr(AllDice$,"66366") > 0 then goto [OK4]πif instr(AllDice$,"66466") > 0 then goto [OK4]πif instr(AllDice$,"66566") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πif instr(AllDice$,"66616") > 0 then goto [OK4]πif instr(AllDice$,"66626") > 0 then goto [OK4]πif instr(AllDice$,"66636") > 0 then goto [OK4]πif instr(AllDice$,"66646") > 0 then goto [OK4]πif instr(AllDice$,"66656") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πif instr(AllDice$,"66661") > 0 then goto [OK4]πif instr(AllDice$,"66662") > 0 then goto [OK4]πif instr(AllDice$,"66663") > 0 then goto [OK4]πif instr(AllDice$,"66664") > 0 then goto [OK4]πif instr(AllDice$,"66665") > 0 then goto [OK4]πif instr(AllDice$,"66666") > 0 then goto [OK4]πprint "Sorry, you don't have 4 Of A Kind."πprint "Try again."πprint ""πgoto [ChooseScore]ππ[OK4]πlet fourscore = Dice1 + Dice2 + Dice3 + Dice4 + Dice5πprint "That turn you won ";fourscore;" points."πinput "Press Enter to continue";enter6πgoto [RollDice]ππ[FullHouse]πlet fullHousecount = fullHouseCount + 1πif fullHouseCount > 1 then goto [AlreadyChosen]πlet FullScore = 0πif Dice1 = Dice2 then goto [Full12]πif Dice1 = Dice3 then goto [Full13]πif Dice1 = Dice4 then goto [Full14]πif Dice1 = Dice5 then goto [Full15]πif Dice2 = Dice3 then goto [Full23]πif Dice2 = Dice4 then goto [Full24]πif Dice2 = Dice5 then goto [Full25]πif Dice3 = Dice4 then goto [Full34]πif Dice3 = Dice5 then goto [Full35]πif Dice4 = Dice5 then goto [Full45]πgoto [NoFull]ππ[NoFull]πprint "Sorry, you don't have a Full House."πprint "Try again."πprint ""πgoto [ChooseScore]ππ[Full12]πif Dice1 = Dice3 then goto [Full123]πif Dice1 = Dice4 then goto [Full124]πif Dice1 = Dice5 then goto [Full125]πgoto [Full345]ππ[Full13]πif Dice1 = Dice2 then goto [Full123]πif Dice1 = Dice4 then goto [Full134]πif Dice1 = Dice5 then goto [Full135]πgoto [Full245]ππ[Full14]πif Dice1 = Dice2 then goto [Full124]πif Dice1 = Dice3 then goto [Full134]πif Dice1 = Dice5 then goto [Full145]πgoto [Full235]ππ[Full15]πif Dice1 = Dice2 then goto [Full125]πif Dice1 = Dice3 then goto [Full135]πif Dice1 = Dice4 then goto [Full145]πgoto [Full234]ππ[Full23]πif Dice2 = Dice4 then goto [Full234]πif Dice2 = Dice1 then goto [Full123]πif Dice2 = Dice5 then goto [Full235]πgoto [Full145]ππ[Full24]πif Dice2 = Dice1 then goto [Full124]πif Dice2 = Dice3 then goto [Full234]πif Dice2 = Dice5 then goto [Full245]πgoto [Full135]ππ[Full25]πif Dice2 = Dice1 then goto [Full125]πif Dice2 = Dice3 then goto [Full235]πif Dice2 = Dice4 then goto [Full245]πgoto [Full134]ππ[Full34]πif Dice3 = Dice1 then goto [Full134]πif Dice3 = Dice2 then goto [Full234]πif Dice3 = Dice5 then goto [Full345]πgoto [Full125]ππ[Full35]πif Dice3 = Dice1 then goto [Full135]πif Dice3 = Dice2 then goto [Full235]πif Dice3 = Dice4 then goto [Full345]πgoto [Full124]ππ[Full45]πif Dice4 = Dice1 then goto [Full145]πif Dice4 = Dice2 then goto [Full245]πif Dice4 = Dice3 then goto [Full345]πgoto [Full123]ππ[Full123]πif Dice1 <> Dice2 then goto [NoFull]πif Dice1 <> Dice3 then goto [NoFull]πgoto [OKFull]ππ[Full124]πif Dice1 <> Dice2 then goto [NoFull]πif Dice1 <> Dice4 then goto [NoFull]πgoto [OKFull]ππ[Full125]πif Dice1 <> Dice2 then goto [NoFull]πif Dice1 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full134]πif Dice1 <> Dice3 then goto [NoFull]πif Dice1 <> Dice4 then goto [NoFull]πgoto [OKFull]ππ[Full135]πif Dice1 <> Dice3 then goto [NoFull]πif Dice1 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full145]πif Dice1 <> Dice4 then goto [NoFull]πif Dice1 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full234]πif Dice2 <> Dice3 then goto [NoFull]πif Dice2 <> Dice4 then goto [NoFull]πgoto [OKFull]ππ[Full235]πif Dice2 <> Dice3 then goto [NoFull]πif Dice2 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full245]πif Dice2 <> Dice4 then goto [NoFull]πif Dice2 <> Dice5 then goto [NoFull]πgoto [OKFull]ππ[Full345]πif Dice3 <> Dice4 then goto [NoFull]πif Dice3 <> Dice5 then goto [NoFull]πgoto [OKFull]πππ[OKFull]πlet FullScore = FullScore + 25πprint "That turn you won ";FullScore;" points."πinput "Press Enter to continue";enter7πgoto [RollDice]ππ[LowStraight]πlet LowCount = LowCount + 1πif LowCount > 1 then goto [AlreadyChosen]πlet Dicenumbers$ = "";Dice1;"";Dice2;"";Dice3;"";Dice4;"";Dice5;""πif Dice1 = Dice2 then let Dicenumbers$ = π"";Dice1;"";Dice3;"";Dice4;"";Dice5;""πif Dice1 = Dice3 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice4;"";Dice5;""πif Dice1 = Dice4 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice3;"";Dice5;""πif Dice1 = Dice5 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice3;"";Dice4;""πif Dice2 = Dice3 then let Dicenumbers$ = π"";Dice1;"";Dice3;"";Dice4;"";Dice5;""πif Dice2 = Dice4 then let Dicenumbers$ = π"";Dice1;"";Dice3;"";Dice4;"";Dice5;""πif Dice2 = Dice5 then let Dicenumbers$ = π"";Dice1;"";Dice3;"";Dice4;"";Dice5;""πif Dice3 = Dice4 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice4;"";Dice5;""πif Dice3 = Dice5 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice4;"";Dice5;""πif Dice4 = Dice5 then let Dicenumbers$ = π"";Dice1;"";Dice2;"";Dice3;"";Dice5;""πif instr(Dicenumbers$,"1234") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1243") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1324") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1342") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1432") > 0 then goto [OKLow]πif instr(Dicenumbers$,"1423") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2341") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2314") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2413") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2431") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2134") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2143") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3412") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3421") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3214") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3241") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3142") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3124") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4123") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4132") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4321") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4312") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4231") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4213") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2345") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2354") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2453") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2435") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2543") > 0 then goto [OKLow]πif instr(Dicenumbers$,"2534") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3452") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3425") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3254") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3245") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3542") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3524") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4523") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4532") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4235") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4253") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4325") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4352") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5234") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5243") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5342") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5324") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5423") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5432") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3456") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3465") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3564") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3546") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3645") > 0 then goto [OKLow]πif instr(Dicenumbers$,"3654") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4563") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4536") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4365") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4356") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4653") > 0 then goto [OKLow]πif instr(Dicenumbers$,"4635") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5634") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5643") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5436") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5463") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5364") > 0 then goto [OKLow]πif instr(Dicenumbers$,"5346") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6345") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6354") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6453") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6435") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6543") > 0 then goto [OKLow]πif instr(Dicenumbers$,"6534") > 0 then goto [OKLow]ππ[NoLow]πprint "Sorry, you don't have a Low Straight."πprint "Try again."πprint ""πgoto [ChooseScore]ππ[OKLow]πlet LowScore = LowScore + 30πprint "OK. That turn you won ";LowScore;" points."πinput "Press Enter to continue";enter8πgoto [RollDice]ππ[HighStraight]πlet HighCount = HighCount + 1πlet highScore = 0πif HighCount > 1 then goto [AlreadyChosen]πif Dice1 = Dice2 then goto [NoHigh]πif Dice1 = Dice3 then goto [NoHigh]πif Dice1 = Dice4 then goto [NoHigh]πif Dice1 = Dice5 then goto [NoHigh]πif Dice2 = Dice3 then goto [NoHigh]πif Dice2 = Dice4 then goto [NoHigh]πif Dice2 = Dice5 then goto [NoHigh]πif Dice3 = Dice4 then goto [NoHigh]πif Dice3 = Dice5 then goto [NoHigh]πif Dice4 = Dice5 then goto [NoHigh]πgoto [OKHigh]ππ[NoHigh]πprint "Sorry, you don't have a High Straight."πprint "Try again."πgoto [ChooseScore]ππ[OKHigh]πlet highScore = highScore + 40πprint "OK. that turn you won ";highScore;" points."πinput "Press Enter to continue";enter9πgoto [RollDice]ππ[Yahtzee]πif instr("11111",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("22222",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("33333",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("44444",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("55555",Dicenumbers$) > 0 then goto [OKYahtzee]πif instr("66666",Dicenumbers$) > 0 then goto [OKYahtzee]πgoto [NoYahtzee]ππ[NoYahtzee]πprint "Sorry, you don't have a Yahtzee."πprint "Try again."πgoto [ChooseScore]ππ[OKYahtzee]πlet YahtzeeCount = YahtzeeCount + 1πlet Yahtzeescore = 0πif YahtzeeCount = 1 then let Yahtzeescore = Yahtzeescore + 50πif YahtzeeCount = 2 then let Yahtzeescore = Yahtzeescore + 50πif YahtzeeCount = 3 then let Yahtzeescore = Yahtzeescore + 100πif YahtzeeCount = 4 then let Yahtzeescore = Yahtzeescore + 100πprint "Congratulations, you got a Yahtzee!"πprint "You've just won yourself 50 points!"πinput "Press Enter to continue";enter10πgoto [RollDice]ππ[Chance]πlet ChanceCount = ChanceCount + 1πif ChanceCount > 1 then goto [AlreadyChosen]πlet DiceSum = Dice1 + Dice2 + Dice3 + Dice4 + Dice5πprint "OK. You've just won yourself ";DiceSum;" points."πinput "Press Enter to continue";enter11πgoto [RollDice]ππ[AlreadyChosen]πprint "Sorry, you've already used that score possibilty."πprint "Try again."πgoto [ChooseScore]ππ[Reroll]πlet Reroll = Reroll + 1πif Reroll > 2 then goto [TooManyRerolls]πinput "Do you want to reroll Dice 1?";redo1$πinput "Do you want to reroll Dice 2?";redo2$πinput "Do you want to reroll Dice 3?";redo3$πinput "Do you want to reroll Dice 4?";redo4$πinput "Do you want to reroll Dice 5?";redo5$πif instr("YESyesYes",redo1$) > 0 then let Dice1 = int(rnd(1)*6)+1πif instr("YESyesYes",redo2$) > 0 then let Dice2 = int(rnd(1)*6)+1πif instr("YESyesYes",redo3$) > 0 then let Dice3 = int(rnd(1)*6)+1πif instr("YESyesYes",redo4$) > 0 then let Dice4 = int(rnd(1)*6)+1πif instr("YESyesYes",redo5$) > 0 then let Dice5 = int(rnd(1)*6)+1πgoto [Choose]ππ[TooManyRerolls]πprint "Sorry, you've already had two rerolls."πinput "Press Enter to continue.";enter12πgoto [Choose]ππ[Help]πprint "OK. This is a list of all the scoring possibilities and how many"πprint "points each one gives you:"πprint ""πprint "'Aces' counts how many ones there are, and gives you that number in points."πprint ""πprint "'Twos' counts how many twos there are, and gives you double that number in points."πprint ""πprint "'Threes' counts how many threes there are, and gives you three times that number in points."πprint ""πprint "'Fours' counts how many fours there are, and gives you four times that number in points."πprint ""πprint "'Fives' counts how many fives there are, and gives you five times that number in points."πprint ""πprint "'Sixes' counts how many sixes there are, and gives you six times that number in points."πprint ""πprint "'3 Of A Kind' checks to see if you have 3 (or more) of one number, and then gives you"πprint "the total of all the dice in points."πprint ""πprint "'4 Of A Kind' checks to see if you have 4 (or more) of one number, and then gives you"πprint "the total of all the dice in points."πprint ""πprint "'Full House' checks to see if you have a '3 Of A Kind' and a pair, and then gives you"πprint "25 points"πprint ""πprint "Low Straight' checks to see if you have a run, or straight, of at least 4, and then gives"πprint "you 30 points."πprint ""πprint "'High Straight' checks to see if you have a run, or straight, of 5, and then gives"πprint "you 40 points."πprint ""πprint "'Yahtzee' checks to see if all dice are the same, and then gives you 50 points"πprint "(for each Yahtzee after the first, you get twice as much as the last, until your 4th)."πprint ""πprint "'Chance' gives you the sum of all the dice in points."πprint ""πinput "Press Enter to continue.";enter13πgoto [ChooseScore]ππ[Bonus]πlet uptotal = acestotal + twostotal + threestotal + fourstotal + fivestotal + sixestotalπif uptotal < 63 then goto [Totals]πprint "Since you have over 62 points in the Upper Section (Aces+Twos+Threes+Fours+Fives+Sixes), "πprint "you get a bonus of 35 points!"πlet bonus = bonus + 35πgoto [Totals]ππ[Totals]πlet gtotal = bonus + acestotal + twostotal + threestotal + fourstotal + fivestotal + sixestotal + threescore + fourscore + FullScore + LowScore + highScore + Yatzeescore + DiceSumπclsπprint "Your Grand Total is ";gtotal;"!"πinput "Press Enter to continue.";enter99πgoto [End]ππ[End]πclsπprint "BYE!"πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint ""πprint "Liberty Yahtzee - 1996 SugdenSoft"πendπππ[Rules]πclsπprint "OK, this is how it works:"πprint "5 dice are rolled, and you get a choice for how you want to use them."πprint "The more difficult to get, the more points it's worth."πprint "You also get two rerolls if you want to reroll some or all of your dice."πprint ""πprint "The best score possible is to get a Yahtzee. It requires all of your dice to "πprint "be the same, such as having 5 sixes."πprint "It is very difficult to get, and you get 50 points if you can get one."πprint "A Yahtzee is the only scoring possibility that you are allowed to use more than once."πprint ""πprint "If you want more help, say yes when you are asked later on if you want help."πprint ""πinput "Press Enter to continue.";enter17πgoto [RollDice]πJoe Lawrence PALETTE LIBRARY Lawrencej@ufrsd.k12.nj.us 08-27-96 (14:14) QB, PDS 770 50950 PAL.BAS DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"PAL.ZIP",4^6:Z&=37995:?STRING$(50,177);πU"%up()%9%%%I-%r?%:FQW+v'o*%%%K5%%%0%#%%j'%fruq%jSgfOxV&<,>[]5iw-πU"xx80[SbVW]kyc&/mpqPT-^[[uyQrfl-KBCr1'>jQA[X*gPn*#HFeh7Dvt_CK%#hπU"hH5_Phj[xu9tZ1EhNBG;,w%mLyN5dWDZDZ6w<G_hR>F6=L;m,0q2=cS,hRvO'XIπU"MuNr^7aXa^g-^>0x&:7>ILy9(wYmh<S7ihGY#ctCVB\>]5K$sa_av'BUK'e0v40πU"L'-36[EU#LFzo%\''6C.xuAQ3\i;E4_f6A9uZUYxO-eX-0Wv5Z/(MUrsw0CD:eHπU"ngQV6\R>o.mz($Jm#]_$ugJl?;50/_WfB+ht_lRxBc^M(>RdG^obyArZLlvV#L,πU"j:Y?ljkeGSe3YClJG6L7E8QGgxs$)p5K2'?tJfJ9g'^M'P,'Y5mo+Y\0u/etW=AπU"v/z>IDC0Zp^9;eR&_&j'D0-=X4bollRE%8JqN7gqWi_6.dAJu*VMU3OYVz3q#B\πU"OXWjDZu*p#E39--q5LHjeI#Rtx8L9S]WPT]&C&PY&-i5(VJnPybD+P*zOw^et%_πU"vTIo3a&.j9K/qs4vWE_R%<o2dfq%C]VY)0OY7&>Y>d-e4-6*8pui_5Y_#FnNnQ/πU"*I$ihndFbIdvq0DjKEK2lo5g#*Fa*pS//mab5*TJ/Te?R^jse&[M22S:x>1d8UZπU"qyN+4F$oq'R0[IYyX<Sr,L)i#8=%&JG;pK+PDmMk.\tbmSrLn<]7KU<zlB:6PE/πU"3<1?F02h1#.<K9(.$-QZ&t0tiGsw2Iddc'ZD91d(bj5Z9\;CR*/jy6j8I#,&-ZGπU"d[rkfL&GJIVI3*W<Z5;=2B3Jgc(z[J*$DtuR)hxc7:v<\6*f\,4mHLD2qji.CjNπU"taiFu=.z[n>RPjY(pd1spSkq;Zg0&ZJywR%uwxR%/9+1mGpw*,OiEDxeIoK(z$DπU"Sv5_8V_nv-?xDxF<?1b3<ak%HEVTlyr-_$dp<^%K[KeG<8zUJ_G&2N7t-5g2TcWπU"+xP,$oQCxOOAGASwJk+,-=YWC?trj)%n6WliFCH+,5J*RX+GtvZ3Kl^dcbjvw#tπU"BQ0vEWZCm&\8M#Xfrg8h+nr.r=_OZ2qgV?1Q?ijH4xWysw+,[?sC<I3ZwKj:ujjπU"jm^:a-7zP\&A.Cu_/>9qth1f;*EMkOb6Mc_\=+M>>*'YiyR9a$1>4*gfg/LK(*kπU"2J[^ymrcG-4YcQu&l<cP>=Ct4'eF9bYFHWo&ZmR<02)IO5kekk4s(gIbruQ)*<0πU"jiYsSmt-C<h&v&bJPYG?PgG%ES<_b4J>\zN3Jv]$>3$aG/0f8j^w'-50Y>Qg'<vπU"9>,nIjzhV9zRluYe0'na0(_uMsB.0ZxUWX6T-G7=ohHHm0d'_1IX,OXLisT8X+_πU"WA7LZ30N];J/O<FIe'MX<%GtbW&Z-GiQd6WO9wB3,.'95D:biNJq,rf)\MGaIcgπU"n.2p4*bdJyalhRe6u_p4X56W7wknmK#ORM\ta[l6#1tMDfnV0.r[oH$&l?wai0>πU"&=_fB/O$SqeO^Yq9&&5r)hw^KcU,eH-O-P%H7*AO&Z)0-5LVM<44L4Lb=?^=pSEπU"4IZBFV2be3RyAUV#<kupb/rDD=9^fv_gZ_><*ahC4\t8D]xYg,m0t<:'eCcZY:IπU"wgKx$UJlEtKF,Pi5I;\8uq[JKoKd*xiCAFsOk-duSMNq326;obhS3.-D#5\F5x&πU".u6U3Fwy,CG=q(o=':8e$Mq4W?SAnh\EvVS8AZq*,N(u%p()9%%%%-.%ha8.FP-πU"G%?<K%7%kk%%%,%%%%ufq%SvqgHfT.+7yzxdTiXTl%66m09D1#J%XZyu[X.4d(MπU"Y]W(/i+G:1W+*U(5rg)U4_oLb)%2h^^5R_-eR1+91I-CBBNB&8vX*BjFH*mYD_xπU"Z2D9;=qotbu8xdpYNvh&WXk4kbJGb$3gF5KfW\,*hUcxnI/$1,d5FlpSFF2,%g-πU"F/:WO%0.?/rE4/?P6Gu:Qg7(jiE^QULY(NG3[<9z)*COp?9BZEARFxI%fEYFEY&πU"Df_-)Qjf4C(/M[&QM=,^kg+,\/39:gh/Rfo)#cY1UkOXe?&)YdOMdd5Quo4PS:7πU"W5Pj_16p:+M2UV/*HQYjG+B/hBCAU8?%+Se0/+*t/f^h&a1&L/EPS:7W5Pj_1QpπU":;g=0>i5#a/P/+Z5%T<:jicreS6iC>K&.<<(1-GfZ?wlNdQu9Zka.*v/U1)VJF3πU"^70/E8SQA(I0QStK)7mUF<YJG78yQk#&5),.F=I'(lm3/-#WW/[GF+?#gGqU^9gπU"&,K91Bp75Q)%%;f^a1&z/Z[a0T9FkQ1>99;q%]/h:e5Tv?%b]9VqX+G9H;7PXeSπU"tE]%(-R)m)P(u+)Z/JM:n%IdD$M%JKZ%kT,51+fRoggO'4F?we0[c;(/GC[K<;wπU"PcHZY-JOgT2X/s9/#=(kg1*B0.r%Sn)1:yp3[shHuU&,NS*mUf51(X_+,4i]aX*πU"(9J0iVK3]Xh8uC#QYS<mO:5.*8/;3EPKM;UVYVn'&H9a$)4G?:8Z+)]_5=:%29%πU"[xE,w:+:YZVwSV?=1G9J:u:*2#E17/:_3;'n'/H<cTiVM9:<I)(dRkl7mUU3+h9πU"%kAg2;'7/:iWq;PViL:kT5EICGsO0mQ$.54bE:#YYvu):di=cM<v#]2dR3O^_eTπU"a2<0%1=F0^/0N%YS8<)n'4(:cT)2cKZ1+O0XFoX#F\hNMWS#_:'T)%k%:5Q:'JZπU"$\7'$m6i#AU%?wE8c_<?Qm%D9#f)#9Y\B]&X<:Hq.&M(j<7g]a+-0:BUj)gT*/_πU"'(u%'pE1?##\mhnTN;cDi&e^&+SAH$iJK4,F?*SC&Q=e?$S<CMg-hIu/ZpX'O::πU"Ti6eV((?9s9<^q.EwOCPbSU(B\_4:iO?eTBYo=.z+0U)bSo<mR&JE.wIE2ApI%CπU"T49i95%)j0Py.gZK/417SXJ?CMSED?*)bP4*)<e.='rE13a/+EEQ^_:4ti\\πU"'&t;^KG:/K;swTFhi(+VSnY&o)h$',SU-(J/=[S(-W(HLqVKg.400.$%Tri1O;PπU"4&/$yfd2AU(\o.S:UDogU9v8mU%1GE6Cw0;g&0Sa'sPZh)X;O<:Ki[;RFtZUk;QπU"BI'0PeLH4Fw?(*mT&U%9GE/[qU(E[U4oZCF'+N;VD).H/93w2R2?CMMPzo05.DeπU"b&a.6%F9kfI1qQhe_(4)=9O9k'Q1DfC:K/.?;pI-Fd;T/2VO/g)=P&U=7[:)EL/πU";3#h>QTa:i9%8T2i3q;Vvig:kRD\?*'32r./I)[PimAVAMTFLYN'14*0,reV(YaπU"1u+],5u,bKU.2/IAqU;eG%e;-,i_y.f2K+GVY]k8Tkq>sY0YQ,QgU=&Uh1IRg/EπU"R.wMV/SG3WQFoQ,.9:^q2/cb?c>TTZS\oU*Keo-e:)9G*c&Pbu4a,ZpqR+?Y.boπU"5:P+[12+0<=g%,hi%Q>P.i[EeOH?^?M''4L'6U1-10W&3e>y99_Q/H4Y5kVR%aKπU"+#/41DR7mP^'G=O09kG<uo:0I7)OUsTX%607II:1^MPJiGFQ1n.ebK41dPq<'GRπU"5/16/Q1AG%CVcni+e/Ph??)MT%b-'053]JU>+J06'0a8504]YMY<=DI&\KO6UP4πU"&K/C(QOju13z/R'5(D&;R2I18&eN,9#BU&?X[3V+)b=m)P(u-$D/Z5.'$0<EeRhπU"?s+G<hkoaZfL)PoV]TF9;NZ-WU_3g&,#E<//dcQS#S/R%RGfYZGI4cQ9fq9];DFπU"?.M_P%unH<r(=8OCI04+9,U%7GE/D[_+B0Z&'-QDY(GI>cQrKiBkTZYT*,8/MU(πU"$\0OU+,,FDPYZ0'=*H9d0YzG0gcQ9q+;GfPQasr>&/5ifIaqS8n?d]9^''*H99KπU"q5GyZ%khPNPk73guEL5=SmA?,1UB4F35[eK9<)A'(T9;[Q0H#ZYk8RKq>&)fZ%9πU"$4a*'Z5&.mU8+:7't9?AG6cSUtO:(h7UN<2\Fq17=3pg%Y=E.\uh?]-;<u&$HO2πU"W2O^0DuM<PiLH+P%]a[5T+*mU%*gQU=+2jUCEgV7'R,T:JBi.AOc\I-899zaXF-πU"T=q7E.KER<;92o)'O<\Ju,X094?*R',\k122/AEES7w;OfYBfQ(.:;^o50BT2g/πU"%]IfKH]<7GX3/;MBq'?p.:yp]\ffUU+/*U6Cw/3'0YVG/4[;*u1*J0dpAQ(ZaYuπU"'wOh)Lo%4iea&gEDCYS#Zn0i?K1FlZ9+PU9p'[,='\mF*_;H\)+-/Pb?5G]:\?7πU"+S9T/?:=>DUB<[/SMg/],E#_%f6a-H^i);&Oo]-b.;*qF\U?U*nOM=.,N_0FJ))πU"m8P2i&nK($ZR7M<#3WT-U.5G/Q^qVYA/PG'%5ZY#cgdml4.gU[E+[N==C,bfvU=πU"tcr(At?-A0U?18/aQza[NS.Frn*U0hw\wUrUb_j2Hxq$rryp\xV1(&OwXo.Z.ueπU"%E\/t,cfV$KX=lwl$\XiW<DT:loNWLZnZ/vQrm/\:x5^7t1T&)kxw.uEL7z><\WπU"fc[WoA(:ya?^MYvS0/:>6DjcgOJAI1x\'OH$36OQyUc68ZIOcUiEj^oOBo1a&>gπU"VHHCttwOg\yh,eQ<f4f8\s2znD,%4/;_tr3>U^a_&20;P_n'Go.6rUVY-W,_wiTπU"[Cw*6ye2gdo0+;fn)mD.>H(8[3ip).rFC.lT9;YH?Z>%P.LJn.yNL97(b=1AR%oπU"CvZt%-/p2GtQ=irT+3cTaYCi(TD0,r30s]N^;nrOpg>gol9m?aKdRuS2pUU0FmoπU"uJ,x'N0Gvm4grETnLwRcacJlr\EDb\>%1MX?g>xn$xGyY0Kd=zs]s#68]ddJJ^oπU"kIp.,QqDkGK96Xlk_XqQ2+Y]E^P4B]=$$Y+3&=3,0DFT',UW-ON?a^c%8YzTr,rπU"vM4Q1L4kR^-&mj^yCTGCdDo#Ps*v5YjGrcJsG\&s9f##n,oKjC^8gVf$IdZkAT1πU"nP<lbiQ><f.<r50blBpH%0rdMCG:o]^SHs6m;BmHZftTnlSibHHe-K.P=>K$/E3πU"kFt%Bl]lY-t0KV]cH$6x8lHmT7($fA$dT>cG$mc-dL#I^wVLQC6,Z[]z<p^8iy.πU"Q0LXJQWoeHsb1V,R$ZEDkUn^wN^cqTrVWTCEM7N8q.N0G%8;H0'6Sk_e-qD%l&7πU"jUI;iRK]OMRC6PbDvjD.qjb<N+4ORDF[*HIB0Kl:J.oQv,DL3r=deE=lt[jzRfpπU"UE>/^%vB?k-_6TkWM'RCw29Vq;.[(XjNqgQ-qzGPm+-1+HM#d]%64-QJt(si&n?πU"A>#P=h^3:E]%;ss$sm&-<D8f#))sIS$THNXrg95-k[cxRE2;=Na=fND2s<r6ts2πU"[3WZ/bu.bJR*P77]Gyfbl[/r,SH\tcLJ3Nb]A+L;C(2f0G,PiQ<u#(?*2<6qfAFπU"$;?6TY45V#QF+yfm#?)>Z&c?Cr[G7k\F$w&mnRG#oF*$VjVbapG(uC2Y7g8+id%πU"L<UGjL=MobERf>/f#?6ickYbm-V<:?#>Z=Hc>[bcMb<kPozJ;dl1$x[-U,PH_9#πU"8yNf:4W01cf0yulegg6duVph-j7LpLz\VtgbE$GBSjQ%>)?bWKiLTY1>+ZRSB9DπU"D4y%GUfrOfH]jX/']]0CPVF&X9C9KX8&Nc8\bJ\=(stqA:MFEZGO1g=D%bUNdh#πU"b2[sJPf))P;HSJVH&hkXdeVY=%M2ZpfewMQn9j\OHVRU=-vKZ+Jop'1#4F><,rBπU"EKep;S<JRAgz]vte0wDvT'P4fHdE[TWDD_NS9b#ZMJ-2sYq\e<.:P+OZ?2Z'8JJπU"/:2'q>Z89cYY3*_Gd$TAKTj=7o74SF7P*;IBj;w]vn:FUdM4)4plaN'LqHTeBEbπU"[lNX?l5x^*b?(OGlt6VTxhKHpn'Nep3%.8<v=T5r#DVfMMwr(Eu8wit&R.Oq7ZiπU"J*ITBZ6M.(P_+jz<_L'HnF&8hsdoR#24O2.AqU1hdTEDh,\tp'Cd]EeWgjyt4sxπU"0/&#KvQINJ8\sA9#\y$0T^&q$?C#gN>__GO\?8=Tlx42,B*_-1__SmwRW'Y/FW6πU"VY&)ZTf2n#t:)[(9&K'g:Re<Bi%:R(Gzf^.Y&T,=fp,6qLrmw?rf2#vr:xxcWvPπU"DQXS6d%qs:h3ZFe1Ffx,%)H:P/m6l.QsD,9Zk?[plx(6UX]LA.:DW7Pr%i5PHE;πU"#P5Y6AI?eL]UQX9)DYE5$oVP8;iS.fe81?K_fUB#cWC<NDG#_QZ%^[,VTW_k%k*πU"%q3$6f.GP3BG$o>Zgit]*V)MeqV2;(r+1*r,0>[LQ3/X\U&KKcpne*i$'*xCT)iπU"sLn,3%:WtIFNwM+ZKJs$G$mt7CPE2U6n5?P7&3%q_O[,p&]qX_eU]H/7]WT7=^GπU"JC1?N47ibsFyPa=L&.BIu4_o]_wdC*L(==>lf^]sc=ln+5<jmc1;FLJl^o?R;%QπU"Wl7.ShfWU-SHr'cL4O((fy9/_jOVn\WDsB(r5o7pisuC9pd=)h(2-57Gm794E?XπU"(7K(521sE\z1R?(zUpk6ThF5Wk6('?x_0rZhuso2.<WvtI<]^/+YZ-YfNo(T;X%πU"BUsti/oca>bjv.A)Oy3aC&?f;O)?jPQ6h2WwkwTB3DBLHt]sycd_BjPOl$*W+bRπU"bsHNjd2scsMcd_BjP/E<264j,LlT.\sytc\,c0<212CnZmfltggU7_3xcGM6L=BπU"*>Ab;>$S$VuV27t>ss-c3dBjPYed*Wr+RbG$n4nnrbKO$m[<DdbX$GCL3uzTNb1πU"LHLwLlKHO$[&;;V#G^wLCL5lpfWAxcdn?n2F:6dl'iES.auO$0>$Ly.6n?n2F:6πU"Dn'iV9n#Cu$fp1pyn8HZsU_Y*nHQG]fTCL5lT&FZNP>6hL=B>)EGQGWnv#C-$obπU"LoN<Y,Xc021/LCZm$nHq$fd0ac/JvyTNI6L=5B>Ab[;v/^eIsFSjd>]]JnkB#>tπU".&wf/daoa8hq/rPw=t?dftz1<Vm:]h%9;g,H>Ou35Eo1cf.2e>>]-S6u0.0D#nLπU"+S(LBOzY-q?%>v_$hGL$qi&1broaVb=b3t'b9(01k+xt0mr\kP3xhETd\*V=Sj'πU"TuS=wP=tK8?j?U;PK-eOSB#Rq2_;u5l8ac:(s6Y/&>O2Kg_4tdctVkLJ:?_os'\πU"lpC6NXHEqiD'iD?Q;vcV:D&6Q.DqN]+3TvqdapsCMHslllQRG52/D/Hbj=FTb<TπU">oUT[RHqf_v<2$/DLU+E%VITjM;\qv:N?I#?'t.:cX18Q6Gf^4#8JD8=K/,2&>sπU"480X]_Wz<<\X^JrR,gqQnaMa=G)[5MiQU;HdZQnkVS7E9>ASAK4^%Q-??YHHuRNπU"+,rZdACG5NY]jpatv)E0KiZkO&2k#BuQoJ<1vMn$=O7Zqqd-QYq\aFe<a($(L?^πU"4juW(jko?IUn:B7^s,C[cGGCGb9:a[)6FbTC#s]PtPh&,.x3Yg,i*5lNAYn$2N6πU"ghK[oi[8vp]DDZil29Zg=k>pkA8,\-*7t^nL+]^TL_tWlduwGpZrhHWb+lEiq70πU"g'i#?BB5yiBhmBH\WOM?C;;Oddh6IH(lalcbTf.G:u,Kwm\ZLKPPfV7%OtXnx?wπU"XVob-'lxXp3oG<dnfVS6bogX2=b*eUSLDthiWMT.<iE?uB/\k7W-:r4F)Hp*SPfπU"sCVe5;W:lwrem(SkL-D8?C^tpiKJuD>7l,OgljDuSs;wbL[D2-HTM%znNi9tsZTπU"j<s6>qkCVdZ3#,d]p9h.Z8<(CbAe&Pl\4K4C#NGGGDXFF:&>JUXSACUpK?\Zu.;πU"5h8zgBPzJ=[7g)80Z=ZicJwhY0%?k?/N)CQ<B,+?M]wNP0VN=DLS\#gShS<WHnXπU"S;fk8I756q-ix(fd1\j_\<ZOTIW#-etk7ZGnUM+sSF7>4?pP-AhS-ft$c^&/jliπU"kw<*j#JOO>a%X31SJRZG#\.NbsT-7$Nsd'Nn0$9aIp/iw*l-E)rsAZ(>^sDDXdyπU"4TZ2.QmjY:q]fLuc=_-<\4qq8l_^\b+L'LT3ZOE$7eOrf9#,ApFAXU9kkdE=VImπU"ek/^7>L9a3$^#DLsv&zj:BMLcJRNd&USY^o6Kg(9$X5.ru5lGMNjoDgW7tYmXt3πU"7_6$?'dtghmZ,pEpT_+?mH8TZ]2a.cq7u#s0xbpbTq4?QU'&]]hGagAIDSk6x&ZπU"'feHS6i.rfvH;0isCa-48Pl$;vrfkSJK#8kAHT6SFF/?oq,_WBPDSv>*aCjWvS?πU",Lz?>bflKg]Kzf>tt?uj+,feJNi^/Ut?J;M*3L0*#EC=5'J6VUla'[B6SMe<0WTπU"V0v#fjRf4T'6CX$ab8Y1N6Rr4YvtFoLp-fBWREw_fXC0q=)tF]hJVfg]dcX2nN>πU"BvuE-V#PhB4mEdhn+Fr0Xb3)(Mw0k(VBU(6>P</L,T0/?MV-MxhwQ%0BfYWVi:BπU"6b%8cK(4Wjy7&rmI\)w^n=e6^bCevsyd>?R&/w>A&*d\8nL]2Nau'd\LZbfjn'hπU"UuH$-gjB-zqNY,Ms01cQh$Jn_+MV&2#QtA5a8a_R]uamkIn5GMCeDx'(8#FSh>\πU"ZNdr8p^DOm*M2Z&0oYC-8KtN8)^VQh0uz)n*#wY#k&-V8J1Y?Vv&&MLW%wpN[(bπU"1Spu$,m]gv0Lu.ZBRhhTc/EIqDJpDMEBc71uU[P)NK-#Ab<qndP$b>D-'/)lBeOπU".[TQxUHiF*tc5WV4r_zj?WP9sp&i$bzLloYejlb?^ANO$$*eVl=f+A2z8]2z:27πU"z#2Z(FAP<25>+lME7n9$sLnFdGjwvbusJ4m;P%#jhfFQghEbm=boItrAIk,lc59πU"8)5UKvL>w)y;)usuMh)T.LTMl)&tIrlUxzMs3b/9::licwMzCs82>9dDb8sI.*CπU"nYzDu%*_GupwzSQmLjGxqvLZL_MyR#nLUiMy/Kn3p>H2yjmsH&cfiIOwzI)auLwπU"\zgmLDrxzI?Kq)bE.y489-Eblj?l$m:L\RmU+_?C[I(n\IY$=XdTaSX,Pfup\xsπU"ov&tYmo\>9xmh3GD<HqO?]mxMBkL5l1rVn1jg%%*NBrhF/M*)^0uQQ&8kYD%Ki5πU"yWsy.Q4%PAa#C:uV](1UTs[SdZIOmK;;-%*xL4cTT5dv8R184jWuYx?Q3Ox*Bb#πU"$l.W^dUQ9[_,rln0P&wWa2c991Vk.v%PNw(0L^MLUZH.NlU4*gkiU?dE1U%?lFmπU"rC,lx62N(PF\Y>_NL+RBQlZc%'NNqd.^_K\ELMUrG.%=O1uGZ7_#0Tb&hujt/M6πU"%rfqmRqkT;rwWTD$Z%aI5i'+q[hpztZ-b*6MM(dE<&5%7PnChSI\h*D(k#J3PfWπU"Q(FKTw[G?uoSGneD$(?oRv*'HCXU?5/)bNYPVoc<2NIDZvsb1(VjY<Y8\=U<1;FπU"P?TUfh-)ik'Rz5+n#\(9PEDR6v&^MpLvu5L^<I8FxxviiKB1d-%nX?j_09LQLqAπU"&dCDCa5,n$XkyVJWo>#=3_U6n<D&scd3td:IUoZGEmCPOImmg-Tkqcz;0c,LCh-πU"Lwj'$\o9u(lNoo0+djdLISmu(9HNZ<fabi9<3jrH>%UZ.qLo;Y,\p>N+Opd0y%PπU"P;X&2B&#y*2MTjDn;#']$0Qj4Q?3*DDsX86,>Ss[rrb^:m$nm[F%%g4M:,RY>7LπU"dxsw<w.7;DvrIsVqzOr/4'T*>^2hdyUJZo.[7o<ut,468('ECNy*UZl\dSe;t<sπU"rFLKLyfunnxr#R1%J2i]AqWXr81%k9v)O#jL#u_^?=KjILZ+F7*FSbcaY5dbg(mπU"rVgbqTsNx_VooFOLa?iJbGKk*ZkIIFDD]>aX*ww];]wP?oVAX[t;N'uygRyzOBsπU"f,M;MXdJ\Dq47;2=_$CKgySAKt?;tsBHOU8TR5iY&]69)*o=grbbrd?\qme9pk.πU"X[ui]6\AH2\2HP1bbavd-A(mYe.vJ*(#>K6Z4*p%P*s(:)FkK2;B$8yK#ThBT&NπU"AI9U?ib]c2f694?s6W7utu3Hg%Tr/X\lWJ:^2]7<k)tGQ.sNi.T<j<E>4hft<00πU"k]nA1D.If3QSKpupQ[)Zwn=6#yO7(D>va[V-3m.k[SV9du=54(#f815SRqVLu^pπU"?iTG#K)?jnA==Z-aNwB[9X>f=7:ErV=<6$JU+k<>B-Ga-k.lWI\_rr=6,VJMkJrπU">\0(Ymv()r2>BE#7'rf\>l9/77rk#kLXiiEwXJ%9kx>Yl?aCOkh2C:+r,>EF3YZπU"dvXrR5[G0YYfJ2[EG2Y^BJ'kZg=LOJ&1kp=f.U)Ce7>rlp>,9aE\[S2JCJrzg=LπU"aJ8v=v$Dr:=L5iJ6=t,Da,n[c#aIKk.1*m4k\FXs/r8>Vs[brhWs1Cr*>;LnJ4jπU"=v_JUB[g3eC<r4s>V<aA-kd4eCDraH(H=4e[C/m15rV>=b;avjk81m:=r#>=b:aπU"njk85mR#k84'm$ktgVIiJLX[m20mar<g=<1-,hJ;k;N0m/qr&J\b9I%sHR'(Cc/πU"V43me%US9/be\IfUCVbjZ;a7&bZ[L-P-o>VWI,]sgd1=Bs<BRU%gS&PU-+$<,5cπU"B5dVYFZ</0A,_XY?.:C)dV_ZJ71kl>VLWJVp>,AaKX=LQlJ^['Y/MC7:*rd=VLPπU"JNjU3mJSNW3$BJ<>L5dJ^><vSJO^kz>vYmJ,[6w97(Mr\1LI/kd[A1TiF0qXI()πU"r,>jbjJy-R926d%vY:R7jhJs7Y8&i+HJkY%6Ri('JcY4o&h\I%[Y2R(049lI&3QπU"02[]5Y5QJJ>2\3C1VrcJ'+k\=rD3CGreb=l;Bayk6CWIdr28[uX5i<7F\r4W3,WπU"Jl=>,Ea7dkD4-PkJt[Xc?a9gkn6M-?a+kV.2mDjkX/mRrkX0/C0rDpV)Ba7[k0XπU"5)<7Rbrt>&52mBk74Ws*hr.qhV#sR#t_RJ>YE-U]kuT#=rR#ARV#kR#PoR#siR#πU"wRUl.1f.dDW<GukjMDsC9=+$%N_S+C#de9#u\^szNB(_AK>G62&v9_SO]*^Ahe%πU"oh9ndP>(7Ot6sDRKN:DW1c<6a;H\n$.mMXp8Ga]c41E5:d]nSV=[9Hu2ekc?^c^πU"x,cDv3XS;b8T1KO*nb'%8iVbw-Tqp>c3/+8?e;bpcY(UXIhs1&=V>t3JLgEaa8=πU"r:ghhViq5Nh^lqxiNDHMOhJu)S:6[Sqv1QwUkCu#hW^&_h3^*]_h34^]_hR3^]_πU"[h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_πU"h34^]_hR3^]_[h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_h34^]_hR3^]_[πU"h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_h34^]_hR3^]_[h3^]&_h3^*]_hπU"34^]_hR3^]_[h3^]e_h]x)Dp4dH([x4/cckH%/*F\O.LrqKqdS;tW[A(=ZBJn)#πU"bK7W+g'NY&E(WP)x=_D_.fQ\:,8TQlH^XcmdsX(CJ_w7j+M;5j,AY237<s6*R+uπU"K%Kr:P6$di[^7x4N9kf&C]nHXf.jt>1jH5ZUnxF+/_voFt8.l$W])E*$N3380U'πU"]9BN;;6a9]EHah.j2a*ly]QJSaHd0sxBtYSuU#'0l%<Pe^;$_hVm1g<Mk2#00&RπU"l[P5.<;jpUQ>hAu%dT4?=/Vs,EPsRoBRAJ\^TYd78X_<\j0WFVFca\R>M<QXn2,πU"Z^XY<mNwW_Z9..]wo&c7Eq+o0ERNQFh8RI0ik^x(2pJe[UERt;B&ec#2EE*U':dπU"NG'/LfpjMnn$jGvh\;Y7aIp3s[Q*]lX;aLRTpp_p6(APgvIf/I(W6Lx[pbFgnVTπU"X4c<VGTVg5e2o;*I^H.nMkjd2+C%tW6HP^\1<fg<,3Ue;>2gIv^HU28e:MAd]nxπU"rJD^EF:Hpd0Zun_4qnyvL3k*BzA8fLNW^\yY4B1IPCuW))IPQ2ptCJ*[_ZSvs3SπU"B3XYI1p=0MPMM=;-m7MmTHL%e.u'cIMpn$2dTMQBJHlUoIU7$Hk)=iAsT[6r_iDπU"Emg,an/tj(>(;B.do<W#%:TasX=teHu*vc^>a*lom0QU12NQG5Mp#09T='6vnM-πU"lB.[2H0d*_'QjDrV1hLdNM7,]2UX3Pa:Sa.FQEUD1;iA4;;sY3]^h#<1V5+9H#7πU"%;C;cB]0gynrY]<r3g=a0Q.fzPs3='faUfviX=&-F2Hx[:w4;37W/tr.\W<wcE-πU"nj$L[VLY[jL1q2u>?ItpWh&e5D$>8[=n[nAvP'4Dr\j.xK>/TE1xmNpls15Z1RSπU"9^()4<m)Le#ddob%+j&+yTy/:wxWKYsNc:ROcVvssgHH:ds_0Uv_(s<rvM2c;u0πU"coG\ilANzPSub&cX?hY#$_8Qgr9mkFJd*d,(/X<eDo%6D2&*Xum&rYng^_-HO(\πU"(8Ft[X(bCTs^iYZ;s(gY^7qMCp5bpDn'InS.lPt77i$r#.Iq_BrU7D(BWOFDxebπU"j>=v4gYnD^pxuRMA\tt9XkUAvo$ZXW3EvfZq6IibmZrGf5KC#R4/7kEfgj0us['πU"0Iemfkb[scBB3JPK?]BB:S>f9v]\ctrUrXUjb$v+MOF0$[aTDjNn)&8m&F<?6qgπU"Ft+]VZK3_pHZrrE^+d0owxUJYrumD+A8JY53,_OrB%gd-3lOJlRBTNclbC'Pmi8πU"\;cM?N::KsJf$TsXMAk_ml$uSm^7FiABp,lS1yx,tHqs_:W<)rIW39rBW&aUq\lπU"TqPk:Dm\K#,8dagwvSAhg?t9n<K)58Usrs8Kt.T(/D4b:<'qu^k.(X0L$:9X9KJπEND SUBπSUB V2πU"e)d0w:O<QqtMwLSYH;qIpRx_#k.OYdun'/4u)7T.JkUN^I[Qgn;.vN.T\l-1qNKπU"&&j9knP8=5KD$.^/b+zfHg,yLR;NK/,pt_oMbDTM#o706K6i3FSb5$3tgF?(8fMπU"nwJ+ImxC1O^,sA6_ce-_8XYv=6VTg<3+PljMh8V:;0uDK3<TC6,g>gWsug0aFveπU"0IemzDm[F&Nfn9etOwpQ?<MxA\4_74OSAs$VDr.ji^U=hs;b]h>F:2OtKCs1yLjπU"IZ%.j'TyFr3p8%mLdW[$mrsA2a88A7L3xGYURtM$gmTmY;bL#m8_xGTMMtUNluTπU"2C5v%okQKRC=N38</c_o587cc(Et;N&Luo<+obHw/)StPs_bAlUmnesII[s:VsCπU"&clS)-d)_=5w4gK6<uHD-]V$ClR-_EWXPn_)WIV_#1?u=Qn-?bIBEPT'a/-wcV3πU"8OndUJMSc6mqs]Ict+QS8g[sKa]amtmb-U]=nNjiu/A57F^WY:s)?Y.J_H/VA5]πU"fW]W./o1Y(=8avE4P5Gh&;1h#4HYK6f)_QFNMb0q8B%u)U3,Z?v%V0:j#LrnW.sπU"qW[BjHVX1xbTYp^0e17NnjK_b_>PK8GMA<es=nlB=3/aq^TpGe/n#m.x?>.L$iWπU"[FFVJ1V;Y;*T/mm8Y8+/EN[r]/]pWt\iG3#7t\>k7L/R7Ja7SX&X.VN%MUbb1KHπU"9wqKA+M+HJKxH;QI87ISW5IbZ#YCY5o\.[/R.*LSc#L#2kcFO'8Uarjg7B]nxqkπU"v=rQtQK559E^_q;Cc2E&Z=7q*BbLHdn:aj$;'_s%ZSK8X<DRKDN1]zN)3M$]IFJπU"2#^*>HP1X3c-E<ZbGREsn2igavD+QGTrjMJ*_s.Aw'Es\<1<63:8Z(1^75,k0Q,πU"=PQNKK00NLQKbL^VguRq=#&\>SMD[RSQ9J)jZ:7JI;'YTus3(;*opWE(u/(km*#πU"Z6)%gOD:m'gIteRJ<(50Y$eUQq;#Zuo%a7ak'*tunG.c?15yD1,08nTu/iR[Vs;πU"Qvr+AD)pS]^qS]QBL#mMBZK^.T2Cg%.eDYfW(^/Zo=tMDH)uE:9eVqgQCgxC[)uπU"8__j8<eX_;)U:WhB#M?uU;[oH*U'0%Q$HxoSU>1IVOeUr*()X82)dLI9v_lYj#(πU"bguw_/Lr?cZ(Fxq11:5XX#vx.=umqZ+Z5e5[^Ax'b=5;=W+X8'j+^r]MKq&p0lqπU"D>XZmmKKfe24;2m$mvqkbR75MRH^HK=WMItq^l#9<tSFd[V8AWss^)Zm7Rs1=Y1πU"LpiYrIMkiWfMY03;XW0y+)6Lq1siWhA4wQXJF1/U80/x\5%E3G%wl0.16fY:-w[πU"C2fidmY9O2iDGR*=[6>xG77<H]8S%+0GtOxjQ1b#^maqLL?Rqo=t-Yx%u%p()9%πU"%%%-.%ha8:F5rr%jFK%.%63%%%,%%%%ufq%SqngEFK0/jyNhi/FLbnOK]l_/S5/πU"g%gg7m#KT5H;4aEI/PaUq.=ex=)/Oem[U.&MT[(.SIEpLzIxB:<Y&TS=_*dGd;^πU"E3wjq+Y'#dGj3$&zY>pmxNsYgv7Brgl2p*Gl&pVF,m5oGbpU>B7#^3$Jm$7;,)?πU"me%jXHF\Ft6_CdpAyPO&KSR\C1:&*A5#4r%pC^94kB4B*S(x#itmgWg2DLuJS*$πU"O;';;2ZquigFA*__,gbuY[?C1VkMO*y*/f[&y+[h[%ga%)\>[3hvVOwci[zZR.?πU"OAckjpl132B))Bumd)Om^1.OHc/:EWs#%7MYy=,gz:8,lI(2jL/VpuMtxxtnh?,πU"cB_Kp2\2pr-[zQi[^(*#vi&8u8].3(nM:x]3mdv22ZQ0N0uEF>GDz*?#Z13Oe5tπU"o7in[&nvg,q/<GmkYlA_hJO9a-Zt353[5sk*-v2pJ1GMSn1xoW%\mIg)eeX(=cTπU"(tHNsOTudm+'=l/>$mg*J,gs?A]o6_d=Nk_(tbG*UBdm_IANKX#J8e9JcU\f[w1πU"gw[h>UWbvljqHm7mnT:<^Z0o>LVr7#7Q?83#fK&%Q/-MbHG4dXj'462e?uI$O[uπU"XAN2u6'niATL?1[^x#V[+='6=EenyL5z&>^kKrm74yxCo3,MxbC0e*7$B5>u0b6πU"j00jI8V>ZoiJ=XI2;>]Jf*t-H=)yB##niRi/]$;5Eoi5d$=#sl(000U)VvMAO9PπU"]57Kj?^&^K-xi6C>z%r(15Ccj3'($rGz\1zV&HS-piAE[DZ-uP[^;e:H-VtGnZ.πU"i<x>\MG*j*b:ZrHJ55MI2(/N-ri:rv[&BzfY6^:MPR(qM0=cGAk:fR(Ud.dmlxnπU"#%\#k3N3\>jx?xUW.U)J6tnD*vSm??DqE(r1-.GCu.IG=HRj.7Y:S:SM[a]e(PhπU"kN-%gC?]^^2ul5j[[zi<n.)dCD7B#;C3ij/EX+V+p%CaV-MQ]Tfiato?(bebf3=πU"l/F6#AO$rrJ1FG0%S/M;8*iuxF780>yCMD?Ud;]r5*OPYeVKq6&FxfZ'l4GxpA-πU"l\LFs<Hm$B/)xCd,:O[&<092GE.zSD:'naFQ(Y,\:ddcoe'Z)=Pe^'(%J=Rl+YtπU";2XFZ?jUn#Ubr&K.eHpB7j==EN/bw/+g5o5iT(SfXA=/$V9*)EU*14ek=O2TofyπU"1:V8'f(R&g+]&DC1_XDlK0bvoGi>R/l#?U2YrDsPw?BqA)yM_OiX#ezv<+2O[$-πU"n*CI<mf)fBqXrscn3&TkTr.:[r6DgBtOUhI4-/v$*38#h&0fV47iRT\8fN6eyZ$πU"MoVk5cK77U1/$wb.i;;sM.qOg66MrWe]feKYVi&Fpr&C,V_8G(0Ct2KjpSNjUj/πU";J3B\O]tL>Ax_0CLR?_%8gQndZ+g\Z5>(2$OZj[mLGuRx.w8F-xAy;lV.[_SNNVπU"dQl+P^x0HOk-h[CUF=%]01MWW/mH[c[2[BqCo,>Ud)cHxl\VB:%#fU#F5_qQ&=7πU"g\1B0mr^\&GE?wr67Ej*h<rP0Tdc*oX;*Yl-:'#z5kjAPSj(G[wea>=MRX5pKK(πU"'SS?S03Wf8y5___QH6;nK2N/G2fK;7p-M5R'PnA;5zZyQ,uqOlCQT59uu%2^Q5>πU"$lQ;jaE'3-G0#8C>b[svW:7Q21G0/v<O(Oq_L=)T?SFv>DFs<PmV>Rie>-*R4(IπU"S=qh3Q9Pa1Ra)7:O0O$jTfTMTy$R+YpH.2g7S33>lF/'VqjqECwuXo.0*/Mh=e/πU"$f9O13)EZx/NT<n+,m4eH]W]Wjf>vN;9:._-cZ_tR[-&$T-jr7PZse^?l5X5s5=πU"#V)#;0>CoD?V7K]ndYqGwSNK3lwI%QF',/=80CgFIJEZw3E'1Hnc$#cvT0,Uwd'πU"6d*Z$e'ASZKUO/;8;)]#k&cu+.*Rwb*wlq-2B=\%x,W*.eJl<;VcG6o/0wPG-jdπU">=c#^%NKKyJC+&J1[vbm;KXQs1.^6>;(w#6:Yi))$L/jlU77'rgb3x^NlkxnJs(πU"-^j]vIKn%)u9gJefTXEwXah^t3PN<O2&BNJ$EF*x;cij$t3eTKx.S=53GeCHl0aπU"uj:.xOHsOmco>E2Zh$;_.:V:I*E)5X?x=g;<0dX8F+$1p/c/TS/?S'<rIwwsbi<πU"np=Q7&IL6Cx'/gsTG.QQsg.Z;kyM'POF.E_*-hl-6m3Fm+5d[jTN:a?rt>B#DibπU".3xxst-+o(lMKAFJe,r<u)?<Y.wh:L>&-m2ePyjGCm\ze)-f&b)U6vD\y;r5f()πU"ia=8vNP1L4z[;\#8svN[uE^w;.a?8VNl[4f&))kYc7%LpKnOg7<its+m*#SzS&MπU";uSi?$AjL)DFBA3Y1$Lg#F[nsuQ^=/>0Hf,GnV1D^z[R/,%=5+SIxUIGBQAL]k*πU"ef5337iYg(>9ofY4i=xj'1mGR20v=#cY91B7VFPKhYW->4m19O2'$?rP'4k=E'eπU".4W-.nN*l+0g]_]rZ\rCz?jl^R:6HlERD+W9&4dAJ^J9F=D.*W0P-fQhXK]$TldπU"/3vZq.WUfT\wYSS6SkAM+OSyPH?US.#ZV)]q#_HSWOW3*cFa3:E$]5+2i%3-i1,πU"F<t8a&gG]V=C/xtG'f3?i#7g,7Y_P?\\V2YA%,<Bi%04[-99mqfq12#<C1^*SPkπU"Q_RFETgq#gQJ+LoRU$Qo:68>gsQYiqWU2Zo[<74F<V&KQ?MgNT#g.bG[fqh-;/0πU"PgD&qfw/9jMzg^TgL8hxsMO8Ein.XD7a_)%?XI+FqMOGLLL8hJbHplnmUv7E^DZπU"NIQfSnYKDa]eDH:h,qL*,N*ZGa+5-R*%C+*h<EdaJ3nQQ&:0f+NBdZrEs;<<'ZEπU"L>hBn**El)CRU9bz2VqQsrU0(dO<T6*8L64DCj2e]2&cID8>Uu(uVi/KvQ=UIR;πU"EFfe,TZwl8FA&N\Pa.G]U(xv'_>\[IR7>T3IX85NJlg4V-V*cCX8wDGE'vU?*VjπU"M=b41?xeLo<zt62/t.]<708eVc;(&=E4cHmQfgsB$X9+ut$T3[BPfZY$,]RbALMπU"_w64Hc*4xg6b]#Y:X^\u4aGXqB3FBqGWf150/X_(3n6mY^Uifs%Ly&I=WP[0WUtπU"1BFL39FcguJjriZQT207>7J2o*:g8BcPBSAUXPc7,#Y;a#W;Mr+bcSH:wQPPN%sπU".0:Yd]5rY8f[hy7TOai%tWjcSH2=UG3_c]+hDH.O<.hzf(0kBjh.'2NAhSe=yuIπU"z*QIBble9Vap-n\2.'v^4^n#:]qAYdVg8XjQS&IodZ;='hDX,A(LdlwF(G=*q/oπU"*'>mTS9,#zHdesT94[AM1.s0tQ[DN)ll:a#>*10AL(%bRs&T+,1^1rc4'm;'du#πU"&;cT<pH6^4k0lgoOHS+;H$k+qXI)gDGjr'nhYGcK#KwF9^2a*FOm$qjp2GLh]MLπU"6u5V[zkq=p;0<[&:dDHaeGnPHk:iGV'X7t8/kGvWq\'wH[Cj[K]jp/v#Jh7WfhOπU"=#1L9;2t8&?swYhzut*Ptn\'oAGs5=C(2&8cDox&U:j?9>1?3T7zMK\0Ie'hO-WπU"TccU)502n'AcZ5U;Q&FOBePCv\rF\;[kk0AWlWCu\?4guE*6/M4.NGx)$WEO%&DπU"?cEb7f.%VvlJRA#A3#C5h7LI6MGRdE]G0SUuVA8pV0=jbVwBZcv7T8O6-1Y:4buπU"i#8G?TL1;?#g=Mw'8dH=d,-[s/k<B3ZD9)l5fOXy5DEl+9Wycb1BVqrJA&-7YFVπU"GK'c.>uKbVQ_kmA)X(P.-d+ma,X=bE[4-pDD[.JARGS)lRX-KIzHQHA*KC7.S3/πU"JKOu2cWJ)C<3TLg:_IvoM=$ppq9u#_GV5d4n>lT;$sWgG9u]>JkK>f,g1%c'piFπU"$I8,<23,huAD>O3iE:]i8F+XKnr:>>X:QK5DS2Y1vnWX1/tp&WS$sEaMHf&%2qDπU"=&Nl2M0&tt&->M=<5#,z?;#?vOQ#OOQ>2L0bVZ[#?#Z+BH2E)+l=g]w>3%pfx^lπU"fR4g=ivb:EY:=4%>JrZ,,*N$PeJn_8>oIcd=1uWpgk$K[1tBu3j:+wUbGUDK0IGπU"qm/2_ZYi'#5Y$goL49[=L%I7p/V\6_SeB=p>E*&JaDmPCt<I2:6=p+=$ss]cdN3πU"=+'oa8]8WlP,Ao%DnQ*7$:OKj'uPqNlHq3hIk$l8vbJ(Qntb$4d\_df.2]>Fi\ZπU"X%=ehO.lILh7yC6A#O\Idi9zJ,oRi+kSXyd'QU93EA<(0[HS&]pI7n5.&n9?Y1dπU"aY,sW:g#=\$)7iD_)%T:6aWivH_5^)AC$gHu74X1F?z0C^Pj*(f_X#vo(f3K*k8πU"bV/_,KIvrN>UoOt,b7c=46#R%lrslY;5W6AGEHKX:dP*N.8&dq4F=/G5=*(h:;KπU")-I#]hnIE8,T+e'ghARLBS-&BoU-=YeAcfP8*oXQ-cW1IvCNK#[4:LO)$6R(jt]πU"kV^sDjs6Ge]/U]gf/yw*[3#;V?tVl:Aa8WtLwJYMd5sdJejL<^tiTU7jPf^lWPnπU"^^P<pKFGZs5mOJbYLo)8VSaJfN2aKt>_bMRUN''8\UReS#mn5HNWBise2t;9_)?πU"YSE3?IbTQ3sCA;[3+dXQXkK],(k/BC<HJfm<1%TO?%3hA;a0tTqQCpYpBW:2C,.πU",>/_LGFkeYQVZwTKXwIYRJJAXmH3]0[xyXYb0p9i(?wtH3ohY(.q=wKEnL/9;3(πU"1m'm,bVIMb'eoL1MoJhJ0RfX6xx)aKbA6p]0=+E>dxP=mTg+,tIxS='+M6+aWCXπU"sO:EH_*n$2g8dXrl7k8H<L/5[_QsdmuWE$GwTQ]m?]\R/WCk9RrK7;aufLt54o%πU"=3</kq6Zi0DRHwh^H3(u?*Djs[g%84]%WRHr5ku-Z,wx\]Or1r/L9T)o6\g0;#%πU"pnUO_K&TOy>5kT^[kMLv6\s5U7c]Pk$wJ$=v+Q3naKnQu8c4bw3EjdWwXusEeu7πU"5PcrwfLFnOq$X82V*phs-a9hTFr\4^KsJi7UavePqXM\RlOI+Dnc.#\1N?S;-DEπU"yr._Xr&lnGqAj6BunZn#wR>;]l&emrCP%O<0J-eEeXr2[E]h(7#F(h:0ZW8p>7[πU"KTJC#TlXH:ZiBBJ3KFqVh[_fHT,)S&vw:;$Wg-n\HRpqGkoh=qf\+4)._JQoI)IπU"\[)me?gtsjB;q^e/33hZ\dMwNAtE-MTCvFea9wZnD'exeXraKX*WYXGOKve<0E'πU"ATa25-k\PPAgQM3kO3<E0,_E:*k3'%iWSRiWSW&[2mkR9XW:C.xZWRy<lv,jZ8tπU"d^-L\3^sJd8kntC$4zlvtl2iN<wRX7tpK#h[f\Dc15^^46Qv69qEN%Kogdvp6SvπU"Y<s:,[msdIgH[s0^8py_D$lPRZT$vN#8YQ#?f)u8$iiwPSrIe#1U0GV$u1Yt?J:πU"IH,-]KN-b(qst^b%Gfs7QisYQ)Qgh6>??GM$\75([1JxuXLu,ClbUKWoK#l+qWLπU"b1s-K\#>$g\n17J\cZ-:I:gJaLG8[CI3393yT7Bw1hKr/n1YpGpOD)lm/:$RGueπU"B(]DM_xaRDie0u%Ao:)W+a1tYtViDdn2&M-B1G0wcF7VfCRGXzY+hW$[Coo:oLLπU"QI'jXGi,9pLb&3JIdq6>X3HxW<=u9aAovM5Mqmu]Q';]]%vlbw^lrj/Qp;CCV;GπU"wWn%l4)/rLXe(4v,-D3b87tAsfi.MrxL(]PsF>P/qI,)iFOB(>?mRdMG0B5$gFPπU"rKl&EUpiIi7yo$2?t<m\K?tC6IboqI2Va5AF<omfYMklRv]$r8?$Nx&m'^d+(J5πU"q%Vbf%stF9Gt^qN%_om(j:i;$2]Vs;G1H7VP<OlY=[pzl)fcr]/Z84ZYa\Uj-:wπU"rvF.nKyM]bt/e.xYVJcBo_n,BJ\Opai*ghgk/=Y[P^Mu%lbxg/FbT*u.W=CX-j5πU"\+Fj#][(W[n%R0r-%MWq8HeBdGa:JNX1q]a98anVrv58'OzP9xb<)[0:zu;N5q_πU"j>Ppv/PB=&zO%Qo9r-jKcg)i?M3R,,E3u(Xb/=N^wi5+hTi*AhmmScrWHO(nO*4πU"o-F.ZN/*7B.c5=-h<K\.1YqNRD0?I>Ga:,4<E^nP.1a?&Bq-28lWfi::*4ITu9JπU"JFz+4z5'g-e01jJxa-QY7nN*E4d^-HN;Olki5rvH)P;(cuKuHcdh2Vvd*Wldo-qπU"5_Fgy_,D0/1oV5Z/Z<7TF\mpXef(r5n[;C_QRa0R9c8(&c8f&QO/hm'Me$[HSw)πU"__k0w1axM/IvY4-1w_i*jz.2P9k]nxVcNdVILfm=.wnTPtg7'XUtZY+W?b;bP1+πU"*b%:4q]-&a^k?Vs:qr8XLAu^<D/6lm6qeO$<$rfFS?9e/TVJ?XP[2-)\^<G;+7&πU"_/kWig'o\\l1(%/szHQ(xAA.0kzHWK\00Rmd.''?N3;vV28-mECOxJXxB&&iP9fπU"UJI;VrL>5$u&CGx$\m2URLSugS#u(9^\'qvWXw#;NECC=yXvo'Rg)F\K#oo#7^(πU">3BK$asEnTX#4_O=QA\RKOQ6*)Y/bz>)&N7Pd?AP'k<1ehzb?'.dHNjFL^ZDNNBπU"[=(kAQJ^gRCc?RYpyklDpLU*b)7EM9L=Q(,QB**wOv(T2>S+Ji(orV5I'ke6Yd\πU"Ft;jK_'%\X<]e=q57FV.Xte?BGthx5VLWi,ScfO&41u'gUcti<&eb\i)jBkdKy\πU"_v2F&$vzoo%/'$)P1JW$s?+j1Lcq;/R=t83-c*XAR/J')wtgBmtrj'+=a'YQ+E3πU"3(vIxs[WO;?dS;ZUuZceeoWK[Ns(XlUPU4=e_I+sw1E/CF?c.Q7[>38nKL11iD#πU"OjopMr:E1\T(yAgHK=7RCQ3hgN5_3r6lmJUBCB>rLIoia<6at<RS,btLzG-J46jπU"dY*]++]Qf5DX[.y3P1[FIQ_yvr5.*kC8F>G9\.MI.iN^/:*W9Qpi8g9N&OG0IrXπU"ba:^M'bXtli%m[4Pet7hC]+-V&(+Q/YN\WJfY,8Z5:7;,Nx<W>IPa]WX==QB5k[πU"T:;+^5Ka%GRB,JQ98n/mma#4Ma=%0Q4dwO3#)MkcES(-qT;TIuJ$s^TtA0Ln?0&πU"*fZni<)9p8B7;BNx,KX9yQBBvwJN<LO3W'QZd&VoUPnePJI%(q57C5&k;k)a+NVπU"OGGc>E4(3UWT4;X4pUteZW1f\0]OO()\'</G+1(6b/6)2'iyIt^.Q&-66.by$pLπU".h$VE,inN(_=d))'IrRp8?Z,)e&y7E:qpbIt=2RKlcg8hb)hO[M7HojBI_W(AXnπU"q'%qyt^RKf(WJzWw-2RAx]F82#/NYVOaL20mO+M^Ho(:CX#1V8ogRH0Hi_(G;JlπU"K\Mx4Y=0%cIqh?B)RB,njm1nk=S#s2v+sb7jGf<*)[[m$dc(\N;1uIBCV-I+j]vπU"uZ6O]][z[WBm\mUsYB5rCgxWGF,r;gQ0-v0>1c-Z-&E1a0Bw2Wb>u_,1HLFB,2LπU">#C%Ci:AP&U>v)w_v2*F$vzKs\mo,I&.C1<]GTG++yJRfNN->q2r';jjvBrVl'7πU"TlA(fMoXg%e2w^DBBD)[j]ZQc-.Q7DJE?wm2u,ay#$7gy9b-6Hs16FfXbVV,UD#πU"mUVGye>.qAlEJWiCQ0c.li#:_.0]Jvb^3vYd^rZsS*.5w<8MpC[pu-'4#-NTLk4πU"VWS^81mAvZ<;Zwh/j#b2D0OcM*X(1^5'/n,RHZj/_m4BCDK^Q]4l3wpS1Mu%C\8πU"*5E/3#7_/-*a#gI2Aw^s2t$6>uC)9Otezcd&#o[zDLNR,z2Pe8?d%zdggj%9xhHπU"dXnU=i%gNnDa62L\2K-NBecTag3$daAcr$*UOOlBG*W:eyvn(%(S=gd5i>tB:ofπU"W<+)LEtIbL[E9qnIL88s)x8e<9)>.w0PY-uh'[g[0j(FNJ#h^v7[t+x,jwx>k30πU"pYa_B*PL/y,Xl.dlspd_.ojzoRi1=tRa:]dKfOwB++Kb0gqg[Hi#Qge+0)?>6MdπU"(R3LF^dQagrVd&1aa]f<7R-)qnmc0:i.toOZZg:kKE>A**LwVgR(<5*%%>=ZmX*πU"Edvf>\r\.3&EUirA<_p,'erAJg<2V2_rD?/Gl?R)h_k]kV=^CrSJ/vQz[,W)MB?πU"/UsRcB\e79NA7>M^2>5[$/?tE4-0Vr:68sv0DMuQ7&#ZN.?drX:+0Z\WSVIzBzJπU"NSJE3%dl%Yn_u+oH43qLs#30'*XOdBT6KuNJ<l>.st#c&YL'.uDD7HEigg0SN/0πU"Vxtz4H-l26rL2c*9S^[jrfn,$/.ThUnD[<<<85FQlmlt9H9]6dpi\i,q;4$-V<*πU"^7uILeeSZ>bhhH><Yg_'pOwVj/ak3/FA$TC&>w(_?G_s]6[/a.?Ooq^L[PV+MYKπU"v(ej)+,6o.=&JMeJh'^arRL'sY7/UoUJl*7IMxr<'_#rxx)U6J=7\/jiRu*bHY\πU"61toQyV6KVy-)p[PNM?m1S\_j)$O<'FFUXZ4/hO;2IIS,$Sb9Qxl:)dt:XZFQS3πU"t)c)UTs,mH:E84)XqD3(<9lsSs&^cH5Tnmz+Eu]L^QpgKBqwMF[E+Xb/#$Ln(e>πU"t&IJZ/'a%Js:ej1E18N_S0A>-]*=0IdXAl7x#E/10#l/WSS,XjJFt]IcgjV25KuπU"m:RkKiiU7Jvmu\pz*Pncm'RWgy)%UQ.*G:chHbmZ5N.mM51J.LlFf8J*l6ve8p6πU"t1?f8l3p%xTsxtS.1MTIr3QqlrUsivl'q?sp1x^:r2VzN6;nhxkB]$Sok)rx)K#πU"x[H4<2fc'XAaX3pQO$S(&2_Cv?GiiBGR$]9UIlAO3B\.*]rUf8*#'uK2QKUVh/=πU"t(TW$fcJ?sF[1q*r=dQBV&1*xe<hJP)u-8/(x]<OJFSaz5'IIFR$;:$at*w5uXIπU"P0Q^Caa><T/:i(FD(ubadqSkYYza+U_ma*wipdXSiTp?iQo_6r1f4'od1%J.'VOπU"vmk^R+airDPOMNrCnm8'$t055QK[3VmWqDCY[sLl*hBwN[*r4u8:4HUiNX(V;L.πU"JRCvnn\D7zJK1NsKp+>:9[NBo8+gmL;0*1%PM<[Z'8)6x5s+srhl?)ejg*lz0nGπU"rp_R7,kMgrFf,u6,L.tr=WWi,xs%u5%5]:2O<z-s6^QR\B6IBYtp4UZ<.\A/E,4πU"i<AGV9,(Hdm5rg-*6><&8Lt9d867IV_HezX_8J4(sXu*8>lQqY#ZcjtAby_$MONπU"]baxlY7SB/(bqGl9d?1e.f*TjzH-H3L8sRGaia%I1-MN5q6i,gt&N%Feo<_tHJQπU"Fd[]?%gck=pF[0U.+lI).ft'?iOUl\/at],?MY_3Yw632U<u2uQW]2Y$D=+=7E9πU".W%N2ueT6w#(JhtF<]'oZI4X)gQ2W1q_MxxXRqHv6nu.lrZJD3;qicnIXPp+mlGπU"uEEY#xBokU_U/:XhII*_g]RP\iu6I[-zukTkyS)tX[lh^#_Z0CQN-Z#)RlMxET]πU"?cIYMIJrX]#V=lD/3)e;,f;vsAmVBZ_-=eR$A]XV.ZrA2$Ha(f_i%3g$vX--L6PπU"=;MwE)*TPt\z0]F<u.hOsQAI8--$5qcFjisrONlOytV7#:,R79'p$q&Eo,Td'BcπU"79B7m]zwahhQ$wB5Ul(GFJv%-bmWj0XD0&*U8$fRt^.4VHM.7(#n\$u]CO\3LCgπU"Lt]=%GhbWH4Mkgm8Kx1rMmd$3wb#RZM1ZNN?%i8b<$^,Yu_tLcEM&HXVE<c24[OπU"QZോtV8Ins*UnN*9scU_J+Cs6K$Ho(fG^tB&-PU^yVrW&uT<ne08k.c9VAAπU"H>xIQ?>4C;Yj-R-5Wt&#wTsmP;bA3L0'632$cT<^LvwfG2JW<D_.D%z0f1u=MπU"-QY&-_0SYRk1=gw>wEkd+s,GEwB0*/:x;7sen6fP9BHNDHb[%rvh)Kqx:jdiQ5jπU"]BH*qX94)bE4xXXn4ULNrieX_%GsG;bK[n49nycYR#E^-Ku,UdpAHk4o7nLWP7iπU"3Am;tuH_dEmbGkf7]-gsB\HWJxWXpOnC>Uax-.SQps#T+l0:o;>j0<exnTJ[20eπU"JQ]M;mMx7pi<oc7u>/SjcIo?2]I]1fufXfh9?hmy0,%+sk4YTmuf%Mv0Uvp/S,LπU"<<(8<Dj2^gJ6Ys2cc[ngD6hkl+t$LP3grx5%bb04aWYaDsPiH,H07/mS6S&Hoo>πU"G,TRYH9U/s.NMbKmL,ah5c5_(L/3;Mi4iNqu)NE-U):4H00+S/4)'$I=AMgsw3AπU"yah*1XP*bcf=<g;E*;AcRnt1)I6>$Z/dxeE?5O;D0XO4_4C=lmmfAQN5I?ma/'qπU"Z(Z1/T&BlLu<#gw9j-0fY]Q:sv7liOZ.*CgnI[i3pDn6s.V?Y/Q\P2wa_)3Eg#[πU"k_M[9jb/X:aiKRTW+sUu1],&AkSNAG4cfsXK*E_1F99u4=5R;Tplm%6c*8;rxcaπU"Pl'anClZD[_lZ?T.fa]O=QS.%idmv[$[k8k#hp,^;WIG7o>aiJ02XDCibdqKrg<πU"RlK9bwg6aR6'3sXi=>svMx/V,&0Uv.;[F.*t.*xg_FFF=Hm57:nbdfAr(a:q4u-πU"$):3h;TbfK9]E.9ZOE%8u)JgTb-Wo5M'Pvq;zI9su_Q$35eBqYPkY#Uy\r/a3nNπU"-Dr.<RH^]2r[.;p-RnHS?$$sc)d>vm,<uG8eS63sYUY_8l9M]b8hDc\jFIZ_xA7πU"(Kq;p>Y$4jkCUC*;q)6=KQ=o,PGMBr4i^HBT[[)wy+7bYi-46kUACd:/3d$Nnc=πU")AC4:T^g,6.b-6g,R>ix:5/[fR$2I'/JZ?q,g&1'-HxV=Wx#84Xy1C89QlYr\kVπU"BGJI[0w\7kmi-q'D)2nG1tR0ewU%?gSK]'-'*AO/X3JQ.<GUQKD8$1de5\HkFe=πU"G?wI(YWF>DJrK24R:[rQu3[L&FkSqaL?kFHut=zd&?:(^+]V/ccdW/S9Ks=,W*#πU"h_RF6?n9%AX7uhA>=$bdWNoXhT'iRoBML<u3MZ&\kMdv]=OSe[?n_Xufkhac?MkπU"Ck:5J7_WD.zkMXJ0Hea:WD*>Oe1Vh;K='Bf'[-o>#4^Efy/rcZ8maje*c>iqk+aπU"oET=Ve<dIha)Jh+B)5>\pVba[]I'l.JxCoqlcMxE)AeIo$)EFXq(R=r,Zg^o#leπU";<VvH-l3G0.>)4.u25Kd7HTWmZat7+X7RxQTlUh3kl+0a*+LoZ]agph+C:dvHepπU"9>=\_$G+^5&>+:lQ2^tYQ]2uL0Y>P[s_jkmGLU)bk.n>+_AESWu**3^PKK$:gKjπU"0c)CTs?>(?J#;hFXE,$ukJW2%pV8Q#KVl>%o8I<_X%PydlBF,n,d/A%'r>)bMYdπU"u=dZw4-b#RSvN81jd$UUN$&V%;md\d-?K4ExcN/Lp0;$V/)P44S0G*nFpwoY3sCπEND SUBπSUB V3πU"'C4pgSaVu&b%7Dw#PPl?8O;s%-Chh4t?j(%5g<N%IjU^V[9?I<bK*f;_K4Jq04IπU"Yfc_ZE#On\ESaC]w7l+k%q3Hn;\>v:<Y6EwZ4+8gPPbb;4l.13B2Dt\4jg:v/QJπU"nTt;\NHOeMgMBSuWqx1h9*8N372e3e$Df(KS\Yb>C.w1ZiO39GJDW:Wdj>/Vs4tπU".T_uDepsM>t4ORM=OO4jLI#f;r]*UnBC4IQ*agDCS-f'uSq*X.mt\_9P:Ge*Q=9πU"Yb?NTkIn#L3t6tfs:FMpBEO^iX9H3R\h&'_5v[Afo't.sscdPhhO63v-%ItY<SoπU"n$>g_NO7<<#h8\7i/eU)FkjafG/$ntX'l=:'PD0v>NQ'7,%nHmBD-bmT,$m_lm.πU"VAnP$URgoRu92(]9tF^_zder]0:GVPbThGUoMWoQE]HkR3\dU0:'Kf5jZuEE;76πU"$CTf)K(YI8$9FM8btbhdfDqlonDMUAt4*NPWe/WQvr_U9<GI[+nEQ3(QYAO.us(πU"VfOo*qRjcp+pii?vn4/P#$:y6?JG9h[EjNRLd?Z&]<e^C+n;,$SG-9Bp9W<K734πU"3tf]vB:.EK?ut\Rcn_A&Q$8,Ysg[]b0:[m<Sc)6OxDmp<Zi[sr8Lim=>s29^F4zπU"dO0Wr[nw;m+W+wi0Xo3]ax/6WgK4p2+AB5up;%D$Z#j+*n/iu%;:z>&>>IPN](SπU"<\ar[9o<H#xGA'lLt>7K?]#PUg*JPScYV^x8lPtloZa;^2^'KsZl07M>M4Zam-4πU"QCe[ppjnT5tiTLC/15,qn/$9iM'jf0i;8V*4Gl+BWpJBD//x7)p_0Q<X,wB)eavπU"3-iACq?:h>ldDtQ)0xCV><o*K,Pu%i*oOnp20D#M3KphDY:#mS4]P(pB2K%^%M5πU"21ZK[#FG1TLQsO%^&y8Se)4q*x7_nPZkh%l-EdT\C1r4hKQOE(SddG]n-o[]sE;πU"(hPT&a'JIW]CD1:/%WFa]WNB:>QuMiJoRHL]isy#*>IvJ49j$id2Djhi*1h*:;jπU"vDEuFC\FDuTin6UZn'Xup(%)9%%%%-%FAe8F[f<nfj%*%%q%5%%+%%%%u%fqSggπU"nt&V,ASm8l6Xy5[hL:(BfRQ;E5#7&&LzDdd3KZ:a&[yo)=_?VJ0Yri7>>lSu4(1πU"H')bH)LW/k;DC0pC9p^v\H&OFk,k9R8A7RgfS^ZLZtfmTl^<[<iCv$6jD:cFaNJπU"Z.-EuA-?J\?P*$Yu'B%'YWF%;5OJCE,WXekNO(ImoEY//yuh0%%b6&xK.o&:A?XπU"%UlF'm=Oa9&k0&x2E^/:)'l>p??E;gG42q2$E\jf^VfQ9RLs:pP4?Ju8C*iC]^wπU"gCG+Gm?575jTcZk]pP[JBe:/SP:EqzgE9i\Ez%KG,k:vbLQ.km_YO*0%GN#Ga9NπU"^KkA%(VK&&C38udN6aMh3#[?/AJXE.y6%a&g2N#9]pAIIq]4PUedm#WE#eDPuOuπU"f6NcKc(41yF'0Are$By32NYpaF2c7+y2>hmzt:$.l.OyOp(<p+a%n=<U&%4CopQπU"zofHxRijgMglNa'rRACq-&m(8NC_q4.Mv<P<I4_opCYZu%/.36x$J+UYvq?>gZAπU"^cq[1qGe\mrVj,X%ts.DlA&IZZO.dTmnK6P[?8q?l'q9N%-f5%iuBHePIL(k5k9πU"WGn:wW8YzFp+R35AV*w[ROPHp3aNC$APIv*1M<H4e?(hx>UodXccrfLvMh/UV9fπU";5\j'Vaj4u$--CCQfy+^=$EL(W>JSXnH.3RsvmF%*1tw3*O'f8e_%f[KPCekUF%πU"#*3aHN4.0)jq(WI;8#;ty^5$Hi.lMs/h(SoTD8GtR4tVU,ej58g0KwTfQIa_&,pπU"AMO:L-272yC$$,l3(W#jrWxpa]B?gjOH0)t[Oz4i$/E_ClA:,<6p10DaN[e-,2MπU"(c0Kj(w#l\5u=vyJ7w:,>Lamkmudr,XyiZY&_g3*lLEn7sD'xK\$[oMS;bEYe/aπU"L,e*D+:<iB<r6N/56Ul8ZW&C8q3*UP<OWL6(Z<4i4XVe8dSgMrR\_<kf4FV=WYrπU"?Ww?m?vKxZ*AI(nB>Z<LsJk7aYL:9g3d]]ai)hIKIam)lb3CF_ny^cJ,UD8MH,?πU"5*o#ZitupBTR?<<_H+4tx=nbL#kXNjBp1nA_Z&l8k'HaEoD8#X-kTa:WIzODvlrπU"b)X$iV'irE4AXBN3[zM*P8Uh5v*CB3hzY,7<urmK+fC2tI7XRKE[5L+l9NF#)jaπU"4dUXcqA6cnd3ovJ#zQO$]gxB3t04&c06NE-/uZ*eH;Und:qU1HUxgM\ZZ*U&e-wπU"93F>+Ht64.*]q0h)HP/WwD4-H230$QLgm$D(UnSfBkQ<$-BZMbpktH0L1jhvA$YπU"hs94?]tPap;ff6?5>f99nf2xq,b3wrElilH&>QR9JG>DpD84_)jJdk*D;k))L1.πU"?/[zi-8;n1A_O3Ys_IJzuLq^opCcSs>>CN7?n+gua28+IGiVz-D;jfAxlPOj=\0πU"k\BG9a_Hmfq8vCa8c]E0Hx\.9=f=9^H_6;B=mHi]f/2S*8bfrZ7Ib-.Z\]O$VExπU"K>8cUsP2oA:4lG2X1(dRhzeZsMwE)PNSjZ2s,$+/c7C-.fLG<?Pz$P;69^pAU:7πU"DC3eSJ';0(x:FiJK:L):dNOr(Fb(z?zdR]1)J]?*#$YZ-YA^kHt.\YZpAtyR82?πU"bpC>7MgX7+S\N**,tw]t+o/-a[mx0aK9BLTU^mng4f^p+Vlb\R>8'1ldG'^;xZ/πU"-[^f2ZbcB=PXK4;?ifhf]jVYpXo(Cn(p.Eq\]?0X,_<>A=8fN3NT]/[duO#w46(πU"<49.+K)Jfr,.a$/fw3h>'wNmts)kJ)ciq,#hHQ,EKILBiD,x8/FsrP)i_(u0(X.πU"TdU>VfnLsT<N,/-rertK*E<3Va&87^p0zx1h)%zqJk9KUfDS>o5J<$#$$.=0F,iπU"dG;N#jitUgcVVr&8-An\T-%BdWBgEZALl0Hh7TVUvqu2>UofVXuhU[(T\?UivxgπU"J,h7>N^Xj'x'up%()9%%%%-%(ea8FPpdpj&c9%%(o%%%%,%%%%ufqS[gfxfjafAπU"T:]axxVdFaG-\,bH*DeA$E*6KDE+;Li8$R(IptEgH%;nf90OIp(InPIfW4&56#]πU"Y%a<Yv]]Q0.JF,x&B>_7C\3C#\kr':b]a;SJDH.vi/mq<=jns#J/rjDQ:q_dXfOπU";Yb9FY1Id&<(.f&/KKk%2\OURZiP9XN^H:?O=l/x1NHYw+#wE'(M)5-b(EBK.'PπU"g.+uXLf%9G[PnS:j5%[q=1&/jb4F;O8PnWf=\dU7R&F-OQ%;Lk1Y/[-f]IZ:oBIπU")e;#dM^254*]X)]3l%LfYvCe;TaF\2?#o]u,=XjoKHi/=*xJ7H\Yd0N>1>U?A=%πU"*$Lep9RL'Krav]n?>w8]1;H+I5Y+[00H)$(*1/Qq\M[,fS164PEHY)>8gn3$L&UπU"d)TS]:9k[+XiC.'^^:9*JEG)Ye<lUlzNyof7_IqWa)f4Ux7gsbc)YtFDlAusaW[πU"S^lVbcgB6-&O+]hs3]I0\w,[tIOvH)q:NtPYGG<(Zt*L<g,N:#,pK%z&SDK-pQdπU"SuHh7b99<Jt/1Ll=X_Gn8DeVVl2Js*F3+*87C,ank?'#Ds$0h3^*eM5;nF7/cr=πU"RE\e5AFXteK#dHdwh70TT%xDV#O/X#H340UO5O6OX+dhF\uhS(EG=bk)de+Jm]?πU"gE8sCh6.9tt:Y?JU(=J)PAa7jLUp-xK;8TM&*D#m=1o:-5/X3p]AZH?_])2xJF6πU"leh%72)ADisG$*QF0g9cT6Z911[J9[?#fmpG4.jCL4V1wg'%WpkF1bV9:*22&YgπU"#5g'AI.^k'U6Po?A?N^<3xHGN,$F*v$>a+*)oL^5/+^-Q;5TVNdP3*'F:Lp+7E0πU";jG.9Im4U/b.LO:*)Pp9u6;V79fUpm:LA>MM7.^dS75U1Sp)PTpGpe?b3hpgF4KπU"V;/&fP\R4aNm3x9FuqIdJMuenG;0]rcJ/w.ZHnm4e1d^E,3Wa;KNQ#t.<]Z=76cπU"L,=FM.aGQ<)OcjF#$:JQ_tl0B(+Sw/H8ZlQn>QRgfs>HqLN^Sg'g]hXxAF^FPuqπU"(f>R)lL/Ok7%]^LBs;1jYo'&35ufVoq\a(xF6*_7t>vCJ*6-)Tu<i--$vPh;qDbπU"l>5xxR8LdX22Hs.bwHa?:0Q^j\0_ZK95lwr_Hy..f9rMQfb9tGDV[R#sZPds)eMπU"r5\EugkV&F0wBV;Q1p7%+>^G+y?\[/(R/KCaM;4x$iZ*^:[)U^U]C?d6-VXmX?XπU"jh\i)I*f7UFUEi.>ijejLa;D2oajIbU)]0lOY*1#w(P?LmTsW]X0hc7+rc::eLmπU"FR:G&U07GBP*oq2]D>([T'F]LP_:((&BUP2lo/Vk_-Z'dBk[g?q;??r$$Z>OPBMπU"225WKM<Kf0^-o5.J7fQq'8xM7s7nnY.bXZ'%AQEbInmlhKyu4#g^X4RFhe\L=.MπU".5k[0U'$Jx(Bo=Y?v\w_/8;N',VW)+>FLdtHP\0?qBNR?n.'os'go3<7dxcpH-dπU"G4[L;duQMd1NUg(-L:,yCF&f.T^.6xr&AhNLb+H&+b,Vs*i[9(jJ1Wh],;FnY,TπU"aA$G/aQ,vAn)F4Of?$CL$R*gkKg\(r(?StHV\;C+tH35^BYRt;61aC(LA0J*1imπU"&VliCMJQrZr(7,2+A<&NY'=uW1=v=]k\ljLbi]]sdj-:I+;w6ROkco7ipm5)]6EπU"^eTaknl0*0r$x='BMp_lIc?&3oE.9<K0kKYU)1So%8*\kGhXZ55]KNlcn7C=*C9πU"4Q,[y%sh7J+xo.,)60*S*BUyrF(Fxx1I^?t^k'^ta2T:uqoR*;B#W\WQ[DQo.DgπU"TmVo;Z>$v>tHCGS^697_k^==8A:Pw^L:p^k6IhXh$r\CfgUAam7e3sYOa[DQbDdπU"FWgo)w2j=Z+xwx7,0kZd$j11b][7AYM><uF?,lKJ_v$Y>(^ro&zP^vPIm$7jXh^πU"gmKxma\.Q?fK;T?MDE%HqrXJ<vVlNrK9KdT^'A2B8h:uU7TXYmL,0a<sUHq?M9QπU"Umh5$cvp=Zi5stvbIl+B2BZLjPw2lUqsg'&LGt$G;3=nA;S*0C%ETSSU_k->:1HπU"+S:)a)(-qg/DW\gZ[Fpcj2X[?anMPq6e;C)QVLF1F3a<]r,W1FLjFN?F\VlMA[-πU"p^^bS3;fu-d6Rd[nYAm(]QDbR/y]g;yVgkyD6Mqvey]6*z4h$9,(fanwWP,x4i7πU"YPNob6gUGDXrs&bB?r.&a5_w>RVLxpApRg0MOvo$a,RgNgPXoakGzkrd9B^j6MWπU"%.o9,R5SgPVd.VtS>8a7GkiLF^SxmIi?Ba7O+Y>.n$IiNb]7OY?K-unL)DQL5U6πU"NB3[CR.6^GuHZcVkGeJwjGyj2,12p-oKk3%TEPPoV)794'SS:#:8\mA?#[;k^;EπU"P;k?8X],[8jz_lMfreEJp5;E^0AQvcoWIw([*Q5&M8A?4fjJh.,41n'edjkH;XRπU"Bw#&:uVNY8mr).[yEe[7>xsB5$Bj0560i:J=k0&r2#>Jns^ovKHTY<i5jruALQ<πU"?-6ymP^WaH.42-DJbt>X?TQzu6;bxtJux^XCxxSo8tVkUK^Xgokqu8=&^)Ec[ExπU"RI6$:6,B)wDL3f:W:hCCp4;KWcC6/A$F*=zN.o70p7CEi?YWAe^#km'_8x,wMhMπU"t'jL'P#CZnW3\6Ag'i[SI+X>)<C/.GyncIfGJBN_H;T2;Gg5C<l$HJ\C:\BgE_LπU"Yk*5_7zF,RQ$Jdj;\)q:0to5E9k=.dp-]'AF&WESCi=t9TO#fvby$l&;d\_ylN,πU"#)8,$Q[j+D(n4<=HyH#\lQa#)9H8Itu\//w70BcSuP1C*X6;RjS^;LS,8qgM77qπU":_#RInX]n:vXFM_]jU14#2?\kAZ=[Z;V=TE6$0J7H<oKpS;>>ppR=&\=H7h)$)pπU"m+-'U*7Q=R>?pg'kB0$R;(2(0QSdL0Ok*:[r'?G8X>MapKrP>pNBa(V+.\I'3l]πU"5.8:']d5qFU*YitVK/b7p%HAK-i3\UfLFr1AKcSUNP[3W'-]3^)<JPc:\iTZ)V&πU"q8Q]X>2D<e2C\mvS._fTGTey\j0BB&JCcm]j,0>p*lQenAc$)jkxG4w'nE:tY0cπU"2,eyIPUB'y9S'2.fGq^AYMat'tD\*R29mLc\dI/ty<^.TF&kxJ4[Sk?Vqhi'rl,πU"b,Ptu9)w$V.'Ycfmj%+HPA:+K6,p[d,\79PVbwnQdpRm3Y[2mkj9M%JVrc^uqV&πU"io4784^:M\<n^)e&O-QaO]6:&TdEuawUTh336xn.+6LmAnT.JOh<thwg8dP>LF/πU"Hkvjc(K8.Mhr#HC<-kMQ^bp:,-fx.>J0^kOm#ieW=7md+l^gu(hM.kq-VDi:,>uπU"g,usxDCMS,iW?C,MNMMomQiF8[dAr'7:%u[R=3NGD+N]8q8vP<EBDR3^Sn^:[YVπU"CF,(eSqqf%^l(#=tX=f-cJG0B0+8>2]P(2rU6,Wa4yf*5\)Pm<aDpuA=rT2e0EiπU"i93:n$j))G/<aAM0<O/[.(P5n(vRo1#3z*,pni5VfoYz?M.kZ/y/2sa(B2Po>'>πU"u-<Xt^d*oR43tV8oGw]P[[8-S.k:FTUWldZ^H?+tqor8C)9?L5=5Rt11i/-K?#'πU"[IR5NNUJqj\.oKwCZgZIY[tmW:%3KtkRbE/Y[f_geY$H=/g(H30EM/dj\C_uHjPπU"Tg.p24Qk8w0^tD?Yyd)NqQlOGptXLDa.6QF'e'D#3lpX/7MJhWfIU;m^qTR6.ndπU"\n#9m7bc9HD,B>x-HC)igR=/Um'+WfQD&IM7z3LwxtOoDbyhzb-8AAG;(kmU6)%πU"238E&<q8HZed5TmIRM&V[#L1N++[z43+WRl:+1:h-s1A^9lejD&jjZc8Cp7C)DjπU"K-Ur,/S_0%D:#(4?S,%h=H]h'U,rJba'Ur,h=.xlle_l*:YDP]sk:i,e[m]T/g<πU"QJ1S2PiWN%edJ>jWMONM\)0^&x1pOxVU<Kqg389'1Tz)YPRVL+a6T#]--%1n1kAπU"#SR,Z=5p#n*&vOzpr_^cg\5(*4D%adW*5)qZw[Y4<#]GdQW2rUHLg\A&9?j*;zdπU"VN<(d6r&VIBe6bt]>PlHXyaW0n-O7][JY^6)G0DVrt;Cuo>Q)PXHJsKi5Gv\5\IπU"fL<33cb*&5u_'%kpH'-HQg9U[L9GV_oaxc6=:vfFAk\1HQ7.P;H&fhrN?&f0<yeπU"*+9'iv/SOpvM5#gWW5O=e+mkU^(9Dou?nt2U&oQq9?5UW(u+C;H=Q?MO:-9\pdNπU"KcKX*AbyNR-O3&*Dj\;xqrm<uure,+XR46<kS'GYD\?Gga;lDx3\<_bW9P_8j?vπU"B+Ax4>(%MvAn*tS(lumv-k'=5T[%.j3//[j^Snu'sO]8m)1Qc?>$q*<$JtlBa1PπU"q+T[GmiZM#-\.emQ*heC9F?D%0:dk:Z]9Qqsc=d(t(9-t7NAvP+m)mNxgV&[eCgπU"wEZ0\n2.a6seA2AtH]xu2*%47KNW8h%+_M?TO&OSIzp-]HZ^UB*8t?NHx^*S?7pπU"9tFWJ4L*UEk*EESETdu29B,jKLKF+lN(r942V3Av6Ha3_>S<[1HcuVG3#8(BI8_πU"1TnF6Tn$$0bQ6t[,xEPK_aOK)]S*0sZY^rB3iGGo,KGE8avIn&7<4X7\hY)[n?-πU"JfV.I4+dvJ_SvjWRtXWDiDhPIM(*U+3HYa]OP*F%=gpWer0)IAP/hLXH6pJS'hpπU"-do]:8G$iLuqOs35ZV*9*4GZO:Xs-(POK2fZ#Z5DCw;lf1d%Tv$TM9zB;DyZ+^'πU"?G]Sr(Q\KmW]GqUtiE4[:c?k3aCY/*dCoQ&E_J.tFE.^'LEWuPeO%vc51_VpWb_πU"s;IqEHOKKba0[_tjKOV%(*K3SK6X[[>Q?SH&Xks'SdyTvGV(UM+puB%c%[^bRUrπU".(w<G('N]6Po,&kP''s<Bf5+_^vs_jszLk5ESAba%-^FkWsO6BPYf-']cbHUArFπU"KKD..oXf$]C'no,:tvP2pnbJ<L93P7'DmSJs*I2Vh=?F8(TZ_4SyEU\(5E6'hH)πU"5elY&nS(CZ&f)hlouo0/M&4).zeoLQT+FGcrE3AK]l*gNf)e'dD1l]E6kYg)m1nπU"&;-\7z3GUsRKWFcMLrNnB&vJe?YUGf40l=$SH-j4SWKnK4<e-Z]g5M,t98)3hbUπU"Bl1?V%fJgV^]qqU=#lf6v/EA$>]E^FWf3*z>_)-kD2Fo>$Z#f\2pa-(%jZAquYSπU"?d&Yi#LcslAj0>bJGbTuYT:2mHiE/T<l$N>x4opQH73YXDS&o&2A#c+O$BO7Y4SπU"FOk[.<F),>GfnAGC:ZRy/KG[y+J2h.T7g^SX%=Dh::$]j(LcCadt<%i/wotIC*KπU"LTfgM(aJT&>EJY1&:H[RtRH>I.m5migWXBU[r%=qZ>8(IR/dDfRvU-6(.k4O\W.πU"v^jj_kt]^jzWfWLeIiz&-0c9$x%rB:?bd0jhLlDt0(xT[s0_[,N+eSq\.bPkLJGπU"%'4y9P-PegC=.t<.;+OZ.SBaC4M(J4xiX70,<j1d<XzOW8)FE3?H'8OnT*>>pK3πU"8lJSgx&M6N&mdYwPhYe6qd.3IA3;Cb+7VcGja/?F^iK1l.N-rDHcsFHP;/Xj8X?πU">#5NP4dbDX(EVRNXc#Ko<9Q-Uc&4PH3,5MFOTm5Xt4LbO[Dv$>34qivQrl8=4y7πU"aR.\ON[rF\S3PQ2*F2[zMCk8Qyg+2Ll_>%Ra7hf%Gvbv;B=fn2QXeRV$(9eW&/CπU"OigBLr'4wUu>7d9Zg6>)&T1T-DWYdmcrlc#P'cQCz*^-W/p53(:pFVIhT5)&LmDπU"VK*C*-gpTyNbh0+niAT&FoDd<3hH]P^QrU;0AH3\j;'m0<<R'LgV>K,k(SG.:MyπU"9V?IjH60qI%J)rAJOUBSka*?RH]p?h7OmZE4TaJ\Y\C8:l3#=kS.HK0;L6K0[X%πU"W(d$Mm?eVAlDHYE.zZ\cpqu2p#>.N-n4**51)2B^3/tmQ?Dh0afblzkK<VW&_tKπU"pp6pb\oJarf.oYnKb^kOLn.OVdo[UO8j6qWf&6?1;:hg.pI'XuuDQe9:Z5+=e?aπU"FOgbV&x45.r.s&]G,X93BiBzm&JDS=+GV7KG[Zun-_^gNpiAM_h<.P=U^u7ROt2πU"+rKlU><^9LFM.t*?90Dd\Sbgn=TBtPEjBCJt4++=bP(0$;WL-.h$%,tOn=IT-TRπU"N+ju=ulxhOgNUjQ_)+7T5lk$+EbR:<WrlXR_uEA0Amz2EOY4'imDdtgd>8,zdGPπU"c;g::n6)c^XmwaW(McH^HE$Cb^e^ks&20omMa]hqDyD]\s*2N7PwKDc+aJkMJFPπU"wAMhk(qmwFx$YMk$*rWqi]snA051j#j,a\8j*c,#MXWZ4BZLDeKVAFJTMG%kB-2πU"dKVl+JH$GFcpX.<KTA4Z0bH*ASI/496zwfD?pau<gk7,m(QHkHj-I.Q'r%O8(NEπU"5PZ849[eDa^qf3SF70j6eHQu%0Q\tR6,Zj^D'Koti\IyGBC*ll5O?=-vOZrU?fpπU"nGI6?Hr)$+gm78g0ML<xeR$Uc,ZWuKO(6fRAw$->qVB,,bMXB;[KQo>1NRSCTxiπU"%qD*uMRmT6d'XYXUXde*D$rofHiTaK2&M^,;.0aD6/sP%Se>76BH33b6]gU=S.3πU"0Emz*[Yg+NMMLZpAHtga0(X)*/I^Gi(X'ukY,)=&zqce:<+>Vrx]go2Gr[Bhz6tπU"geZ^mt4[D_LuiwWE\on;JnFR-7x+u%p()9%%%%-4%V::%F6lv&5D5%%%#c%%%,%πU"%%%ufq.Sy'yKV$,blTA#hQ%[N7Yx]S,C<WH&PecCxFy+Dc?-$vWkFPF'-CD5=GaπU"\*5<Yh:w?58^\oTzB<#bI4xIyCb.GbgCO1)ots'+rpV\CLw=.qtNtAFt4K?El8dπU"rw:8prqzxqZHOl.rqvnu>#T=dc90kg%^]VK2R:$nKhJkzex:EnPSW>n?qalEpR[πU"[ZY?t=Nq>2oXrqvnut8T=GrlJqvZXRANltjNsXbsL$W_.moH]x%6m%(98+TZ;KJπU"?*v?m,Lqvj18.;\vaMOS]%xq]$tig)xAnK#ySR07.t8Zs7G>K:olA-/c(tf1#'YπU":RQ<;R[XEnHi%CTJ%srX.\9+g(c9E_5'o0.X\dn+[[<-QwIf:_Yb+E61ed(x$.oπU"p8H%U;wZtfG<C8c;'to[3)0I7iUzOX/]?2)roW<^&Y2f1W(I:gIgeF])gvIK,$GπU"Kp]AB/b_)^fBqh'O5*dZJn7&?7^:Z5bphBEA?)Ht3-feu*E&uyE_i*B>\ZEh80rπU"'AhaZw][w+ws*6IM7Gi3-(nd7#-9j6AfISyUREr&gxIQwP2SfODm69R-3(phJ+#πU",Eq35A8vw[N5/K[S8J+8;*qrVuR+?I1isxQkC7$/PZtl-o3=Sb%nwq#?neXE1MTπU"zZ]uTNUS6Ot?jvaU6O8\pL)nZJD1^np/C7h,6C#PVW(tE/J5J2cXO$&i;eWjkT7πU"IkW*qn>bnvt^p(Ac_\DxiNhi??9sabKKO(I37QbTom,&.U47ebGOvQXYZ+]F<c5πU"ooIjU%amCxgmF^U*)AsML-qg'\y7nC8ER+XT&ajhW96c-9?,EsHZg:1[jW:A&FPπU"$UV5aBLm[??nb;[%;tah5M#sbm3O^G5k/uI'0?p;_G_U>3sH6vHaFfbr]iiaid:πU"fy%=;SK&Y4,4A^u:$U;7=sYRG+;>M+C:^)adm?':cvDFUIkm4cJ]*,DUcss44A(πU"VA6V-:W>yK:FW8wH.9%_2nOx2CYSfp?T_(w15o9(S;UrETdq^.)Biwh9H:/lY>$πU"C;TNY-j4sKL)?B;Q.$&MTV_H:P35&tsm>Dq)(Y(q7gu67l%IB7wuI3\?tQT&q\EπU"#FR7/7nhBeau_'u)y_SGnN6Z5$Ec[18OyGiPhrgCC:k\%F_kytBA[CR7&EO-S4nπU"?eSb'+8gX2/8U?G;?A:M-(J8If%',#=?2[eRlSOA7G\HeHetKSh*#DwcbTiE+a*πU"QH?5i&pbE4OUz:29;H6bRhR(QMhLGi&IP9*42^XT=a6#Z&.t1&]KGhSXj5KY<V'πU"kJ%'O8mb':V&aL/q\?&j])NyAo_$CN1L37(L:Sl\bkXAF]M=h]M6HrA[Y2$7(g-πU"8c]N%T.2jggapDs3Fb5JWYIrhZeK.Bfq2pF?hPh>]?n<XdCoN]^VL**_^R96g/*πU"[Tm/omt,-RKWp(Si._:2TKfPEB[X[PfCN[ZPJqBnlVq[T1*8'O-XJ[p6og'5pM)πU"0K5-5ZeBsI+38c%]R1o0m.Alm;-BQkuEnQ\.);Zaj<)%8t#R'/JcCCe0xZR)$a.πU"%JZ%nQvqjZ(qmJUdVP6W$2Ko?qqa+U^NT?5UGc[;$Pipnq7XX2_)UbdY.)D/p%*πU",_>[i?hI:;d,FQ>H('&d9XLar&_aq*uCq4Khj6AcS55c?'>NFB]P:<3*P=;ATReπU"Sfejn$6#C:b7bI<Ob8HF&[j,7=g/idXa?m+8:()]Tx.2jrRiG7S<7Y>$AT)QeBxπU"Wizli\QysD<rkqoSUsT0S(9?Dg)My5#\6]2NfyTKaAh=LQTh>:#qrwaDb1Z9hrFπU"1i_6tN1An>Ui*lQ:-m/q4EoXB3\&FGTuPC:U=$Q=g%[q&'7%&>k5=k:,\RVxK<%πU"n58vPSEQV7Y.8U$Gr-<_=1J#VaxE\2-j*vJ)7vZb0xMDkG2jlljqIHIBY&:1N3-πU"G:y*cZsj\h#*46#SAQ9B</;/4mI$[#x-:S[(]Ggy-754]uE&s%UDA_:RRNb^B+XπU"ZMW\u9/#8+pfz5h<7]l]1xBPTYj8i8k4;dR]*=K2G4X?^?q*IgpXj*0EjQ6K.v0πU",w./EG]\[cd-nt>2/.)r&Nr2'kmJ_YN\,5e8aWGLgtmS6un(Gku,DTj,jj)CAcPπU"j%FE8+?(O$d^T#MDTdo;<h(oh\v.m6P\pUdTCI=z+RJaXi6H1=oxu\/=7+J^7xHπU"SZieIbC0tE+__tbO=yR<sR)oIqNhB>u2w9&&NRH,%>$Y:?xA?W'\[?D6q3([hG1πU"RKX)fxq+HS#/ds3P#LMNh2-6m8Gp$7X*r]GI&p#>JcIg5:&WU_A0gySmRsSULh*πU"O9/CKbGUYH>J_intDOnf#&5Z*VfyE:7A82OR&;j*DC3<;X]?(O(jFdII&OQSG##πU"HFG,&2J^4husnrZ8?]u,a]KPIIk4M_EOS=kDeCw96CN>LGF\B(u:d4DYbT,z4pSπU"1MP2*vY_bT&5/%_DyMT#+,.6cp?73qWAfP-9Y,I#qJsD'$.6-&2)#LyQA3Au3:;πU"g+BT[jfz?mxt$mi-iM<TZJGvckHAj-v#S&&D?kJ0&YQ^(>/)xFiuEO&waN1u3AhπU":Z,,Dbul4Lj4\)Vur[xSd&[^^_Xd(l[j%&(jo&BCHU5zJe;h>%mPdMMNs9:L\NlπU"rb.Fc^TFt2u=XA-cdGa4iCDJ3Ra_*a$Hgqq1Q8&icMxE3;zT0]Tndk8f;]pI?]HπU"cW\:Z=U]xCt*n]c$u9wFe+HA;.;:[mgywC_8,tGS>>4lMtI^i7&yN6*U&*Ox+?=πU"syZv_ggR-dK-CB4oS$iLkn%HM0o%f\/x4*g=FM;P'9V>Tl,$Nzj2p&'dUpt7QXFπU"i:?'k\39)Y4EgGhMkd]:w=kWe4d+lAI#pHruf=F5OI%kV=-h_2Ve1W:rD[f)4N2πU"sfg^g'd,i_J;&yruu&BWD3'#=g=:WN]-#Mu=1<9H]srD2YBh*j1u'\/(<d$ZR,fπU"?P)53D:l7z-++dlHjA:UI&Nh*d1<hO\B$-n8-2D8/\YS/YUyOPfPRc<ZsNGUva#πEND SUBπSUB V4πU"TJo'E(0?Kxb84q1k\^0kbUTab8()G0-drD6pmlk0KHNS,LW_:X((o4JaWn(k0)#πU"ylBhzax]]jOfsrj7^OzB=0lFUY522(*'*bD1$DdMn0A0mNwEoSd]13H6BCb>zbJπU"yYS[/*euaC:_DzH)?ev#_.JT/8?Ys)a:ur;/pw9UG.=:+:Kb/=wDb[cnR-kr,7>πU"d&z.IAk,i*1<6Q<<=T3k]ad4A<AMZSQlZ:/lP^Jz&#,v2rjXjAu?vf_z0$J&;ZYπU"iv/2y<'9Eu,r]+SXyv:Dq0xh6?yU9vTBzL4/;Th2F_[Y>Y=R:qNC#<%6hxk0g(PπU"cYZkCbIQ2;]TZF$:ks1OPL)*:JaeHPSHYjG\cOg0?Z_7-Bk=L+[:d?thK,XIrZoπU"p7mvHvl=nT*v'wi/)KfA7AMCHID6JAQChl+b?nBt7rtfTj>MDKLCHw-$0M<X^QNπU"2_HDPcoM?lpZh.++wI't,dRh5]Wl?B&^qps\Ne+pzwS&\F6_;OQ%;lRs_QvK;D1πU"FhEHETLJ6,=KS%7s,#+#MhmHoIYckN?G=4^iC1guEVtCBX,:=*g\yY/gMCh(bL\πU"fv3FW-AsKZJLrUDyemtN[hmYr*-2P=,\\Qo&<RYlka(Zn^i(+:hyDn^U[,1,llOπU"#'<4m4s?vdS4b&H>0uL\tbjqksNF;BAVTd9e9bv*nXB7=l87MnsvLP,iOT^(\.ZπU"[:lH1fhoEE^cRK65l8k=vEo&LXW+b+4?E6AYAZ4wOo$7sarmx:k<ac/f\;=Bd0sπU"j%>8hxf12I3A+DNM$Dzee8hDeKO<N6+]\<X>t,W+#)1w(/ZrDW>J;rWn9*\uO^qπU"<QCL?E1zLf_8\=M<=JV<t&B\qSPT0D_$4xYg(ooWd8AsFZUBsjfM?CbcrOaL(&<πU"RAo\MUcUPOS57.A>=;N7(Y1Q#-lgG1>SsXuKjHTMHZ0?Npl&T3=EMZVPi(CNy#iπU"U+?:<O$VOf&)ar]EWy#lG)&o^q$&<ubN_E8o)Qo\4G$lO<#TZynWcSSZWMlw'K6πU"Oqo-z]Ja-/_x=0CXvC[=]i=N&Ug&uDuUc?d0)CDQtZ(Sdt;ofR%c-OUk)3HK3LBπU"s$Wdq=?jjeu'.:.Tc7SSnyk(ThHtV#,:8z,L^]P<^/KM_-_w,gG=VoJG=MLF\2cπU">emE=<JSYfu#cd-g0)KVZZr9wH*Lik2l(txR^Z<Vt&cvy0*je8;eIs/0=.8+?J]πU"?yx+f66#^ODCgEKmKAbUMTq=5UKn[PZy1Ik,8D?gV%\eLq:AK3TSj/gBJEq\[_NπU"_i,:h3R8T6c6VFR2>]>I.<0wn\:j,gVPyFhE8hVX2\[NPo?&QoP2q7B59U?X>n<πU"J)+yplF?p&xDaC-s3A$2x$?UH&Nnx#4NkJl#H)-DekgL1-obFMVu<dD<U0VZG0PπU"2kZ?YVXh/u;xs%4B<>r^F6JVP_Zm9IS-#r^J4aUgB/+1H9Max,W;vhStpv-rVZ=πU"#n]zDTQ%mtdsV5&tuvd?;JK:iA]d3rq2HlJ(rn,VU#B$UCQb>jDR$q1<sx.-^,jπU"\8),r;m_f$F/9S'dK1,]Q6K]'q7bFAKA&,:lfAj:%&G:H;3vh$452uga^o-5<<TπU"$d9AXjZae+a.Kvi%1S=t\D=:N8FUc-_6=j*^uX#Q_I3SvN;s#ja:F;(Si#PCo1?πU"Snkm#VNSS0*iPAxK/6)KR1Sf*ZkWEv.+Trk9#lVt&\VjuU6uHE[wG=V[+r3u<&3πU"GtDm^-,2Sh?S3F.'VCq1z,=0g/3e3&#;l-NmJXta8%21a=oLVR$jU?AmXbx[ZjfπU"$GEM?9N_aJWLu_6CI:N$CVA,>hDJ]#ST\(1trOfI9nf5DA8PHtJ=wJ3mdj\l1gEπU"x488&BwviRb=&py&81FRn$=m^IN^K_WiUEuK5Ch+*9(#W/t-:j0Pe9_5)><dqBWπU"1^f#A.ST\,d<g4XQ9Oz38lG_ZK'K?KWliZVsa<?n5,#&VgAjFiDKC-.?:a^-$7rπU"wh+*C/^%Rj38XHKFS5bijoWb-#tt+;0AX[Ra*UDMv1<mZ:5KZj?F,B-HT:>k]#QπU"1[zn6#ijt2#[N(jTrlE=W7cm,fmmJS6K4Fk#<J'8y8TyCKyE,iF&_QmzfpTY)vZπU"#T8lFT'8PvSfqt=+hvB93m'L<n[k>__+OF9xA]*\IEB5McBGuqhOVdzITdkN/2$πU"\J_'Uet\$9sz,Uz'\,-ak0\cAA2mVJX)871tX=;b9S=YR>H\<KJ)e(]#AStM/m+πU"-Xtdu%p()9%%%%-1%6?:1F]LQ,w,:%%%%g%%%,%%%%ufq%SithNfkJ_dAlL#8*;πU"+ta<DTRH?Q+)XgoVXZVjWm?&Q;=$X2J&F^VBF(L38guJ4L4s$UEm;II_s<dS=[7πU"/urH9Z6Cjlj?49.*[^5%E5Uz&x'gC5/eYh1vPONFA\'2.MCH%Zrw36ioDFK9bg)πU"nOVk6F_=uD8lgwDpl(4NdQ(Vd62[<N?ld4=VH;Qh2V[LgIH/c_)83L85n>ts2r#πU"s*or$(%QqdR6hfxA3P/itJBi9L$.QET\Nk=uqik&+Jirr[-mk:NP6gS5f)^R;#TπU"Qu.2?-#Y2oC38cxYcH$SjT\'kG8(7Xkw.:#lY+[q&wxMuses#D,k$^cG6qGnQ$,πU"KYjDZb1OT\MUdgqH3'c0TeRi)U\ZMr-'MX3'dj^g8gATayK=j-qo4h=+P.SNbm$πU"cu/.b&jJp29+SRE'9a=Um-lK;8q>2giF=jGiU:P8wH2mi_4'p.gNrAe&6F6H3MVπU">SxI[B&b3dIQ2i$R[6mx7$f;aXDZ*a%8+LN+7JBOZ(<ilG8Cz9j4ZOh%5D^9ol6πU"cz=S<Fle)EExv(4H^)j5Za_aZ5\R)I0QHd7G7jh5)l7K&sVf52W[y*Y89-A(,wuπU"*;5Fv:7&$u)IfOFgy#]D&KEaDG0Fxa:L83'_0&aX?X>DhL&.$M#zF%aVsIl+(N_πU"-ogOzmiTv;#l,ClnxejYSd5I*vg-ZlmJ]*<of?i<&Q+L5k&OY.dna[UP'Lt9$EVπU"ltJq=87;nD_IEehw5cDI8Rxu65Qp_d^EtH_:$YK31m]H$(aeSFs\vJN_wyLs:ObπU"T)ZVYtT;e2-rFb'<;vcJ2Ar<Rd]i:6?:M=UU->(O<ijV>;5Z9z\G1t_uo/2M+1YπU"0iwXT.io%s'-OIQzu&DdslBK;TV-#qZqxQtWaC%kqj/-6]fK89q:(=>BWIP9KcCπU"rH7:BRGxZ$\ca;DpuJDK2>$u=SXOMq(6.7vREA7N/S4^x9^L*/D_+Zz5=Tik7DmπU"kqn&k+w85$UGFTjnM>WHiW?7#rY<0li%Mnt/43'4kY'4xU.#wH.Fj>[W3D$,i$2πU"7t9e33iGV\s[O<f.<G78WM[W7CMWiXIfi#Ld=wsBWU*E4:NsvCyyp&F[\+.4/NYπU"T),jjh<&sf9k%j%lJ)7%xNwA(t(ZL6w4Sk'AhX9k/sM6JA$AFx2)Ho'>3?+7mh2πU"c:*(f<GG)93wVk&=Q#<&uM^Bcg^s$]zI+4BAdZ>$q*hlfFD%LGxx*aLqPd&=KcoπU"/Pi%m/*(9i'LVqbcjZYY&sn[p.).JF/Ythj\lYg'1gh.Hb$[zt%kMiyc(Qceu>7πU"]DK;twEPv%g(K[yBxE]8+hB)K4TWp$B7UR#4BOoLv9)j_ZjKn;EUYs%\jcC%/XqπU"f=G]DlD3lXy+Ow\3FA7Xm6QeV.*jCh]IHLU\).%f80sOP5)uqJ:?u;g>CkM_95mπU"e;3R[na?\iU;eR?>1XA+33+2;85-.X79Igirw&'0<DA+lW\Le-I\[11ZU14MπU"\e/&tBem*N-UgQ,Gac1rjd,XF6ID]+^St/&SFKf4N-[X\kF-,xgGL/&CrN5Osf[πU"c>N^'D*0Q]Q^1[zC3VaQAr-M:0V<0z8iO+(D,T_TC>BrN[zZI^ATV2(,-Ez73ldπU"U1.rlyppovS)RNuwFP;Yq?kJrPkqCXcX/h=.eor<4?O9&aw7ONQ1<B]00iMqEa-πU"'S+\<L^JPIXEbCILCa8Rc/d&gmidiKfo.iLWpKh;Y4L;em+sCeh?*6]Prv.=(=?πU"/oRz=bfki)=Jy/imsTV%%Y5m^(%VNihSYMG[AQYy]E87g7*(9yvEly-8hCs(:^qπU"GYP8<s)<gr6Q2r+aMdCyCw-G-__8g[de6I'sH#N%A+zpM9nA0]]j8t/j?>%q%zrπU"/wdhk6dFDwHZ*<aDH%x+PT?e:/#fuleNzl+19t2G,7sWzK<*rIQO?pxp/>1-%FMπU"H$i+C6adnrq'\#zjL(?OKm(lf4PgBB&Sf*Qa?L3?4o?;/?[MbWy-g$KGU0pr50rπU"LtKU8_Cbz&SEfw7v7/0sv3*-Bb/e+7m\Wv3J43fW[o5,PdM,c3+l8#V1h?[+mK9πU"m:k/DI5a=3U*PSK(JTQ'Shhb0e%J&DRO9e+;B#A?<>:7I2D2RHQ/?rD,+o>2I0ZπU"w4Q#kRO;kgnDLh3x_?gUvieDxn]X4gswM2s%rEtE=K7h)$35ZhS.zmX7h^r^h>KπU"H:Ka.$oCGugKYb$7x7[,J5O)8bGNkX>wYRnVPUw'3jY+l=>+bp<3s89(h&HN:hvπU"4_;>o_9I:?1THh(bZ-3+NhGf_Bd0'zejE]X/($4i)Y1_X[Q'bykfsE1XNu>BQKOπU"OP&aL'dTy-Bp'T8u><0tz+#QCp7n$kiYkH,Z)SFfovikOiQ4+SB?jA;Kc=M%;sjπU"HK,;O7bPIp6unhNS4GLkxptz=Si/=5TR+Om1j:n^%J,ZT_\Y#8<NMt8a#o06xL\πU"tdlo,x0bBi'^UDu6GZaz>TIQL*1p(uGCD(4*ay,0w;>(N:#vUc)C_eeEZldlo%NπU"F[Uf^BEqSeh667%FIlUiNk[(bo$,5IlN-'M\5>M[[ORSr6u:XQNX_jtk(Fz'qvbπU"ocfJ'6NEAzb\iK&*/Z;K/?bHKqnL]Z=e:+8m*)2:EcT&xd_?prv*NA;-)G,4^-kπU"v7_\#:-c1&bmlAGmh<MbWhNH#qsDh=Of$hOm>xG1hL0K3#vvXlLGuOtD.toM4_9πU"C)lg,HEZIW[JVlBKup=mqK]0FjAjHJKu\R7*&$z.4/h[8\JXZz8.qepAIca*(foπU"yqvh%9nfa#TZKef'T5J;z,$m1*lXb)2sGXsHGv4VTQq5iW0$\SmjbAZ\\.Vm(e^πU".l+_V6oKt:Gd9o:ACOpq*XSJr&,]WfhA^V*j\gJ;C?<Z)6(ksng[Jv6(xBr\jiMπU"sn&*A.B$p:sO(7l)XJd^XQWu)mrppyJw_%+LEK?$L)/d8Mg(BLFmS+XK44z1-rGπU"hittao+'&e*dlP)v-Z6\(2FfFD^x43hyoF9FPf%=^gLR1R68:mBRBwPmIhqiFC/πU"O.)F>O&<\R5LRcD03gj3[Ha7VAdS08X8iB,y+%RXil_KH1elATej;?WPp84V/BgπU"ye67IZrd7J?7p-3JAD4R%z'o6&l>H;A?2AY>0xEi$YJh'Q:^qJ=h?E>IZ4^HFOBπU"jiSb\#_;v;6wA#>u3_gBc%4rmO',B$?$m^.cX4jcIzK2=-Ng/RTvn:1<N+V4*KdπU"rX+wnm)VLI7]bhP[>.OW-Fah#?/r-)#<3Jqhy4k#AbMY=\0ic9Qt&-q$z;:<$]PπU"ko.zN-A?,N43f5O*Xlg5,6*(p3A.erkOE'Ps+m%>CS$nb8e(,6l59K5%leT?Gk[πU"zt&n0#hCHu=5VL?^S-=BFow=6_Mi$+eUk.=hNK\Zl_<FCga<&oT66vkTemRQrπU"jhRbx:(j%[XutVHIbTRYC_HRN7SCn-<H1=;DKbk(X<#CCuB]XbvVb.Tmh*J*eI:πU"R?ImA\).<:6bD[CNVHbXYyO-PfP9Vk'b?r[aQPKciF3T=ciNZ2t4DGICCKQD:[NπU"w<a7xDdKwn[;iW:4Hb^HqFsCg+,3P[k:lF=lUuxK>KKZ^6=MKIFNtS/;(5hE0>VπU"s*\z^2d8#TE9dsj'm:l;?NaxNO]R$A;RyT-J.n:+SDMKs2bXAS^:&z_)ig'JvFlπU"sJmoe2uXkD%W3EHfGuOxYF80y&m>l4ePZ7PqN&\3AlL/bX]+#tfDX\s>;i$e^PgπU"JKguo'_?bvDX^r>M2+2D,&'_,ZORJ>ne2as/P&FCf>%8vZ&Ir-'k;B=QHB554Z[πU"$DS^m]'jOaNGmeEuo5K.OTb]*qlo./qH3gb2pY77_..p+,mSCl]EaV3aL6NgdnRπU"zmh:\Yq/\xyZu\Ri444Gfo+X4N;RG<p<CM9;v_:-Rgu<#NP/;MI$_%J#[$c:_lNπU"kb7-Yk[YDoQHF;[LBh'N-v-lt=osv8*ulW&_fjkibHH%k1Zjge_X6xbYh#\V\sVπU"fb%bS^Vfxf7YJH,g1Oy(+GspWCJBKxv0M5'a^Z<Z>(JRRX?TSTk,vSsWX=PSzDVπU"CM/G=esF(ZXG?j/+$BgCdkIb?cI.0WI2q8us?0:PqR\Xa\bsY9/E[6Pms[j$g:QπU"sibZn[.iVBL166[mL<[MBdR$;uHl<_Y+2XGFHHB4=\b,hlq'Bmr.tGKKu2juDn1πU"0nM\(Pjt8l<Ct'dmNVzjV)Jhpjm;ew6RW8uZ_1C7'zHfLFB:+.lgIt\sJF'6VAVπU"lQ/nra.45C9gw'Qj[9rAFAtLkNObA3=+2]iwNsGrv5a?iNh.:0(apobnKo7+bc3πU"<+lKoq+lZ.dt$rr'IZU8w<JynxP*Tch%$Wd\$VLK+JmIsUg9D;=po1MK*_8s.u#πU"34?Y7PAG)yz^?<VVBO#pXWrQ6F7[qa,(jKLS/u0GYyz&>mh$,'>r1X0l+URgZE8πU"&,ilgeCGz4<5ZK(Z3gVW\\AL0iHa\(/j[riKAHj*Tp.fy$gfo-Gh+AkM'_5#%isπU"6RX_g,q&EsAzuFAV.3;(&1YjQsVYO2GhjzP_iA31/%HMZv:*d69k>IGR?Da&iD/πU"xCxI^Y:Q4ovttv>#H/9sT81fTejgeMVGXU^6M)p+lqaTA(F4xbu%J]px:UBoEoIπU"qW\_&9j3bc/ssEV4nu^4fHR$4;'HHw<)\)7Le$If^HM<VBA7.wVQWM^6t>/(9fBπU"60ZWAS_Y$u3v-TemSI<$u7=(f6D<)XG[IA<]#8NP?yR/'IQs/yzxZ6CcgqBF3d<πU"QJ.C[jiBdMcpNoTOHDG$X9(SfOR7\&t4x_VJ-c=D;,*Fnj\<BVr'v?\R_7FU>&NπU"rMm0>A1hp+v4?uVg4n(:EJ:fZnX1>BYKWq0Jy#=tf*hr-gpA$J<)iDoa.PrjKkiπU"A+%%5s':A%/r:>X<4)rW(JrSungfj&\WCP6]]:aEPamrk3]%UJxE9#fLUYoBFXTπU"F/rj9J]e_A)$GY6fDwFwBlqiK8=d+j)[1q>VImZjC/]emnSySF#W7&\4OCByst2πU"&MQX>K?dTE>ZZeC-<vD)yyVmYg^1AeMh^7,[rmkjFW)*f3j$XC]5jE3Z#n;wr?2πU"YV-PG\;uQ8gj2_$0kI[bVn5N:DAEysJiFverQ;6q]+SB#f3bfkqVT$hY.XvKc#YπU"AKj<wMlrdTohX0iQh5DqS_H?#kZ]u/c3D>cDtUrj<mHhd]a=GYlo'1$+LZf6$aPπU"6c[+fZ\oil+.2)G?nzrG&_0W,n\l;o?r(0+H<fc;:MhUW:>+ro:vbt]_,%]K8sdπU"-OxwaEQ3?W%nIk[CkyPsO:-)5?r.i]wEVr^]9jt2^tP%qDoq6K:.5^WpcdmT&eFπU"k)rhq15b+sN#Z18-WqVLtS-*e<,J2z?,sQ1?f_ja64]EN)[Zk2Op=g_Y*^p<$diπU"KV,dA[h?\&4cPd<F3j+a8#AtpkWg%Ym$+07YED?MnNg8l7^3W47c1g,:4O8^k\*πU",TC=j'>U#/e-Eiv323pO6:4>t,UF&g)F\Pt:fWhTQN<*n+D=bwQHU4N\:R4bituπU"8xuXQW#MJi&Fl:s=vkctqmtKQoX*Itm(w4sdu?wpcvhraUTnf2NJy(ohonY=Ci:πU"ZcmZXY$D*>t:/G_[r?m6FHcA&?F-]t69e/YGor?ql4&?-49W-W)0g%>+8>>)_0nπU"MG1GGT>*F'(,>C)n%nI)XR[iFP4ia[i3iC-G9kKv$[,+,',29i/i_9iviV<iLi(πU"P?Zh[:.?uqYyhhN[DD4,_N44*9t>tA6te6dfDch/o>,RVWmD$*j[O=_s_pqOhlTπU"n,ToT9EtM-dwWDv.Nr,Ero;Ppf(-<T,kT/4mUrQKaebMT;/jsEBTsFGW?l/qf)_πU"Bi($Y%G1KM3/73M/G3/233/dlNDz:c\Y.ifmB[FJQ<P6>n>QS0iA?>#='FGC$GLπU"':]j*H9Y[iO8?\qNBq4UNg32ZYuH9d9a#9L9885C&%*5%*%c)c'Bg(4Rq._Y$FVπU"oq?a9U)WF'w6KU.k*b9*#9a&')T+L\QfOMfQfPDfR/GaT1#U[4C%xj+/mH-Q,%,πU"]H,'u^.G21+,U4C%%d&dF(TS/A;=qQg7wOTo9$:4o:<92[<gC)+-W3cF2g(^SRLπU"9Niw_)[N48ZKbZvO(K/[MLldGNwrhbxViOqf)Sjm/.DO,t63e)?B0qb?A'U0c)%πU"c'c/%c+C&V^Q$-$='CeF,84];P*9BTYbYL<Yn9X_mPUYb)i?iaEq^qXJ1a1'?S+πU"h'Y+Ef#BA,FMR>Pn2R.Q0pS0eb/o1--J=+FQc49<:^dOl:k2YJYb#i)qd6M-C3QπU"do'D+?#GF:1#KC#K,k9xq?S+)H&,AO%z?aP1BU(,M%sJN;2JZ:nY59i3iSiiH?sπU"',>#%%*u)T7%:ioui#Y&TYfi,e?;6e(A?C](D+-S.'<RpZ:(ba_cf4W+/W3CO(2πU",[[^E&((&N&c+37'CI)tO$rV[2Yasiri.U=G3Y2\Yt<Y4Y]9qUqpuihY4D/;42)πU"&P.EZ:&YE9i3i5PGS4[Jl3A/7.)YrTY3i#?iPYxTYLY6?YKD>04;+,G+i&?CTG-πU"KC:K,;1D1;4B1AqQ7d%()0h+.(%d&d(A63X%.%j?H010K#AK,1]aU/<]AO(/oa-πU"')t69N/d01;+,B',8/#/A%V'9W]+9W(W,9w/u09q6qVC]>T2g\O8iid9NC3d5?TπU"9q$i2Kir_NLS2&OaJi>i[E]$#'Qfu+^/K?ua=u9e0EXE&8GCqh9ilYxTY0YZiYJπU"/9)0;51qP*:f0Y]GZtG&L*%Td-//&U%)fh*^L)LPV&'W1c&Bg,4ONlZ[,a-'nf9πU"J^I'>>a,r%d2c\:+H?ws$n]Pt^R\eU6J*>l+(Mn2M+3XW).^D?kr8bYI8$fj$p=πU"fHvtJL=N-XZu/euZdT[_s9l>ToPU;([sB9VrXK=ova2/xS?;QP$Q8rvi?DwH%=<πU"0hSA0j[G(3*1Y\n4g/Qv^;pd:ycHZGYe_WmfRH,Gb*wqjDW5m/iAQ_=E?TE3d7TπU"Y;b^LY/Ym&r6NYmcT9>eC'52jsXH)VMaM_nD-6td;55C0qKIuahK85+N=MJ<-ksπU"Du%p&'9%%9%%#%-%r&?:FQ7Wv'o%*%%K%5%%0%%%%%%%%%&%%E%%%%%%%.%j'f%πU"ruqj%Sgfx%up&'%9%9%%%%-%(ha8F(P-G?%<K%%+kk%%%,%%%%%%%%%%%E%.%%BπU"*%%%uf%qSvq%gup&%'9%9%%%%-.%ha8:F5rr%jFK%.%63%%%,%%%%%%%%%%%E[%πU"%%(%P%%u%fqSq%ngup%&'9%%9%%%#-%Fed8F[<:nfj*%%%q5%%%+%%%%%%%%%&%πU"%E%%%'nv%%%ufqS%gnup%&'9%%9%%%#-%ead8Fpd2pjc9#%%o%%%%,%%%%%%%%%πU"&%%E%%%(/'%%%ufqS%gfxu%p&'9%%9%%[%-%V&::F6.lv5D%5%%#%c%%,%%%%%%πU"%%%&%%E%%4%<;%%%ufq.Sy'y%up&'%9%9%%%%-%)6?:FD]LQw',:%%%%g%%%,%%πU"%%%%%%%&%E%#%%,L%%%uf%qSit%hup*%+%%%%%,%,(%E&%4%Xa%%%%%πEND SUBπV2πV3πV4πCLOSE:IF S=70AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπJonathan Leger USING EMS WITH MEMCOPY ROUTINE leger@mail.dtx.net 07-11-96 (22:56) QB, QBasic, PDS 357 12711 EMS.BAS DECLARE FUNCTION NumEMSHandles% ()πDECLARE FUNCTION NumEMSPages% (Handle%)πDECLARE FUNCTION GetEMS% (numpages%)πDECLARE FUNCTION EMSPages% (func%)πDECLARE FUNCTION PageFrame% ()πDECLARE FUNCTION EMSstatus% ()πDECLARE SUB ReleaseEMS (Handle%)πDECLARE SUB MapEMS (Handle%, block%)ππDECLARE SUB MemCopy (fromseg%, fromoff%, toseg%, tooff%, bytes%)ππSCREEN 0: WIDTH 80, 25πCLSππ'**** Show some EMS stats.πIF EMSstatus% THENπ PRINT "EMS installed."π π '*** Open up a 12 page block of EMS memory and store theπ '*** handle info for later use.π EmsHandle1% = GetEMS%(12)ππ '*** Store the PageFrame% segment so we can write to it later.π EMSsegment1% = PageFrame%ππ PRINT "Number of EMS handles in use:"; NumEMSHandles%π PRINT "Total EMS pages:"; EMSPages%(0)π PRINT "Available EMS pages:"; EMSPages%(1)π PRINT "Free EMS memory (in bytes):"; EMSPages%(1) * 16000#π PRINT "Page segment is at: "; HEX$(EMSsegment1%)π PRINTπ PRINT "<press a key>"πELSEπ PRINT "EMS not installed. Aborting."π PRINTπ PRINT "<press a key>"π ENDπEND IFππWHILE INKEY$ = "": WENDππSCREEN 13ππ'*** Draw some stuff on the screen.πFOR x = 1 TO 100π CIRCLE (159, 99), x, xπNEXT xππEMSsegment2% = &HD000ππMapEMS EmsHandle1%, 0πMemCopy &HA000, 0, EMSsegment2%, 0, &HFA00ππLOCATE 1, 1: PRINT "This image has been copied into EMS."πLOCATE 2, 1: PRINT "<press a key>"πWHILE INKEY$ = "": WENDππCLSπFOR x = 1 TO 100π LINE (x, x)-(319 - x, 199 - x), x, BπNEXT xπMapEMS EmsHandle1%, 4πMemCopy &HA000, 0, EMSsegment2%, 0, &HFA00ππLOCATE 1, 1: PRINT "This image has also been copied into EMS."πLOCATE 2, 1: PRINT "<press a key>"πWHILE INKEY$ = "": WENDππCLSπFOR x = 1 TO 100π LINE (x, x)-(319 - x, 199 - x), xπNEXT xπMapEMS EmsHandle1%, 8πMemCopy &HA000, 0, EMSsegment2%, 0, &HFA00ππLOCATE 1, 1: PRINT "This, too, has been copied into EMS."πLOCATE 2, 1: PRINT "<press a key>"πWHILE INKEY$ = "": WENDππCLSππ'*** Show the first image we saved.πMapEMS EmsHandle1%, 0πMemCopy EMSsegment2%, 0, &HA000, 0, &HFA00ππWHILE INKEY$ = "": WENDππ'*** Show the second image we saved.πMapEMS EmsHandle1%, 4πMemCopy EMSsegment2%, 0, &HA000, 0, &HFA00ππWHILE INKEY$ = "": WENDππ'*** Show the last image we saved.πMapEMS EmsHandle1%, 8πMemCopy EMSsegment2%, 0, &HA000, 0, &HFA00ππ'*** Release the memory we were using for the demo.πReleaseEMS EmsHandle1%ππWHILE INKEY$ = "": WENDπSCREEN 0: WIDTH 80ππ'************* EMSPages%() ****************π'*** When func% is 0, returns the total ***π'*** number of 16k pages, when func% is ***π'*** 1, returns the number of available ***π'*** 16k pages. ***π'******************************************πFUNCTION EMSPages% (func%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(66) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(8) + CHR$(137) + CHR$(21) + CHR$(93) + CHR$(203)ππTotalPages% = 0: AvailablePages% = 0ππDEF SEG = VARSEG(asm$)π CALL Absolute(TotalPages%, AvailablePages%, SADD(asm$))πDEF SEGππIF func% = 0 THENπ EMSPages% = TotalPages%πELSEπ EMSPages% = AvailablePages%πEND IFππEND FUNCTIONππ'**************** EMSstatus%() ******************π'*** Returns whether EMS is available. -1 is ***π'*** returned if it is available, 0 otherwise ***π'************************************************πFUNCTION EMSstatus%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(64) + CHR$(205) + CHR$(103) + CHR$(176) + CHR$(0)πasm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(6) + CHR$(137) + CHR$(7)πasm$ = asm$ + CHR$(93) + CHR$(203)ππEMS% = -1πDEF SEG = VARSEG(asm$)π CALL Absolute(EMS%, SADD(asm$))πDEF SEGππIF EMS% = 0 THENπ EMSstatus = -1 'EMS installed, set to BASIC's TRUE value.πELSEπ EMSstatus = 0 'EMS not installed, set to FALSE.πEND IFππEND FUNCTIONππ'********************** GetEMS%() ********************π'*** Function returns the handle value for a block ***π'*** of EMS memory that consists of numpages% 16k ***π'*** pages. You _must_ keep the handle value for ***π'*** later calls that require the handle. Example:***π'*** ***π'*** EmsHandle% = GetEMS%(5) ***π'*** ***π'*** EmsHandle% holds the handle info for a block ***π'*** of memory 5 16k pages in size, or 80k. ***π'*****************************************************πFUNCTION GetEMS% (numpages%)ππ'pageoffset% = EMSPages%(0) - EMSPages%(1)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(94) + CHR$(8) + CHR$(180) + CHR$(67) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(139) + CHR$(94) + CHR$(6) + CHR$(137)πasm$ = asm$ + CHR$(23) + CHR$(93) + CHR$(203)ππHandle% = 0πDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL numpages%, Handle%, SADD(asm$))πDEF SEGππ'asm$ = ""π'asm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)π'asm$ = asm$ + CHR$(86) + CHR$(8) + CHR$(139) + CHR$(126) + CHR$(6)π'asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(10) + CHR$(177) + CHR$(0)π'asm$ = asm$ + CHR$(48) + CHR$(237) + CHR$(180) + CHR$(68) + CHR$(136)π'asm$ = asm$ + CHR$(200) + CHR$(137) + CHR$(243) + CHR$(205) + CHR$(103)π'asm$ = asm$ + CHR$(70) + CHR$(65) + CHR$(57) + CHR$(254) + CHR$(117)π'asm$ = asm$ + CHR$(242) + CHR$(93) + CHR$(203)π'π'DEF SEG = VARSEG(asm$)π' CALL Absolute(BYVAL pageoffset%, BYVAL Handle%, BYVAL numpages%, SADD(asm$))π'DEF SEGππGetEMS% = Handle%ππEND FUNCTIONππ'***************** MapEMS () ***********************************π'*** Sets the page of a memory block (identified by Handle%) ***π'*** that is located at the beginning of the page frame. ***π'*** Example: ***π'*** ***π'*** EmsHandle% = GetEMS%(8) ***π'*** MapEMS EmsHandle%, 4 ***π'*** ***π'*** When the page frame segment is next written to, the info***π'*** will be placed starting at the 4th page in the block of ***π'*** memory represented by EmsHandle%. This could be use, ***π'*** for instance, to store multiple SCREEN 13 images in one ***π'*** EMS block, by moving the first 64k image into the first ***π'*** 4 16k pages (16000 * 4 = 64000) by using: ***π'*** ***π'*** MapEMS EmsHandle%, 0 ***π'*** ***π'*** And then putting the next 64k image into the next 4 EMS ***π'*** pages by using: ***π'*** ***π'*** MapEMS EmsHandle%, 4 ***π'*** ***π'*** ... and then moving the image into the memory block. ***π'***************************************************************πSUB MapEMS (Handle%, pageoffset%)ππnumpages% = 4ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(86) + CHR$(8) + CHR$(139) + CHR$(126) + CHR$(6)πasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(10) + CHR$(177) + CHR$(0)πasm$ = asm$ + CHR$(48) + CHR$(237) + CHR$(180) + CHR$(68) + CHR$(136)πasm$ = asm$ + CHR$(200) + CHR$(137) + CHR$(243) + CHR$(205) + CHR$(103)πasm$ = asm$ + CHR$(70) + CHR$(65) + CHR$(57) + CHR$(249) + CHR$(117)πasm$ = asm$ + CHR$(242) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL pageoffset%, BYVAL Handle%, BYVAL numpages%, SADD(asm$))πDEF SEGππEND SUBππDEFINT A-Zπ'******************************* MemCopy() ***********************π'*** Copies the number of bytes specified in 'bytes' from the ***π'*** memory location fromseg:fromoff to the memory location ***π'*** toseg:tooff. To copy more than 32,767 bytes (max. of ***π'*** 65,536 bytes) put the 'bytes' value in HEX form. ***π'*****************************************************************πSUB MemCopy (fromseg, fromoff, toseg, tooff, bytes)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(30)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10) + CHR$(142) + CHR$(192)πasm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14) + CHR$(142) + CHR$(216)πasm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(12) + CHR$(139) + CHR$(78) + CHR$(6) + CHR$(243)πasm$ = asm$ + CHR$(164) + CHR$(31) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL fromseg, BYVAL fromoff, BYVAL toseg, BYVAL tooff, BYVAL bytes, SADD(asm$))πDEF SEGπππEND SUBππDEFSNG A-Zπ'****************************** NumEMSHandles%() *********************π'*** Returns the number of EMS handles presently being used (there ***π'*** are a maximum of 256 handles possible at any given time). ***π'*********************************************************************πFUNCTION NumEMSHandles%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(75) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(93) + CHR$(203)ππNumHandles% = 0πDEF SEG = VARSEG(asm$)π CALL Absolute(NumHandles%, SADD(asm$))πDEF SEGππNumEMSHandles% = NumHandles%ππEND FUNCTIONππ'***************************** NumEMSPages%() *************************π'*** Returns the number of 16k pages being used by the memory block ***π'*** that is represented by Handle%. ***π'**********************************************************************πFUNCTION NumEMSPages% (Handle%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(139)πasm$ = asm$ + CHR$(86) + CHR$(6) + CHR$(180) + CHR$(76) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(139) + CHR$(126) + CHR$(8) + CHR$(137)πasm$ = asm$ + CHR$(29) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(numpages%, Handle%, SADD(asm$))πDEF SEGππNumEMSPages% = numpages%ππEND FUNCTIONππ'******************************* PageFrame% ***************************π'*** Returns the segment that you will need to write to in order to ***π'*** store your data into EMS memory. For example, PageFrame% may ***π'*** return D000 (HEX, -12288 decimal), and then you might do this: ***π'*** ***π'*** DEF SEG = PageFrame% 'D000 ***π'*** MyData$ = "This is a block of data I want to store in EMS." ***π'*** FOR X = 1 TO LEN(MyData$) ***π'*** POKE X, ASC(MID$(MyData$, X, 1)) ***π'*** NEXT X ***π'*** DEF SEG ***π'*** ***π'*** Note, though, that you have to have a block of EMS opened with ***π'*** GetEMS%() and maped with MapEMS before you can write to the ***π'*** block. ***π'**********************************************************************πFUNCTION PageFrame%ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(65) + CHR$(205) + CHR$(103) + CHR$(139) + CHR$(126)πasm$ = asm$ + CHR$(6) + CHR$(137) + CHR$(29) + CHR$(93) + CHR$(203)ππPageFrameAddr% = 0πDEF SEG = VARSEG(asm$)π CALL Absolute(PageFrameAddr%, SADD(asm$))πDEF SEGππPageFrame% = PageFrameAddr%ππEND FUNCTIONππ'****************************** ReleaseEMS() **************************π'*** Releases the EMS memory associated with Handle%. This is very ***π'*** important to do before you exit your program, otherwise the ***π'*** memory being used by your open handles will not be available ***π'*** again until you reboot. ***π'**********************************************************************πSUB ReleaseEMS (Handle%)ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(180)πasm$ = asm$ + CHR$(69) + CHR$(139) + CHR$(86) + CHR$(6) + CHR$(205)πasm$ = asm$ + CHR$(103) + CHR$(93) + CHR$(203)ππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL Handle%, SADD(asm$))πDEF SEGππEND SUBπBob Perkins DIFFERENCE BETWEEN SADD/VARPTR FidoNet QUIK_BAS Echo 07-09-96 (21:36) QB, QBasic, PDS 50 1973 ADDRESS.BAS ' > Does anyone know if there is a difference between π' > SADD and VARPTR? Ifππ' They are both provided to find the offset (address) of a variable. VARSEGπ'is used to get the segment. Though they may appear similar in function, theyπ'do have differences. SADD is not to be used with TYPEs or fixed-lengthπ'strings. VARPTR is used with those. VARPTR can be used with simple stringπ'variables, but it does not return the offset of the string but rather theπ'offset of the string descriptor. From that you can determine the address andπ'length of the string. Note: Be careful playing around with poking directlyπ'into strings in memory. You could find yourself facing a "String Spaceπ'Corrupt" error message if you inadvertantly change the length. Following isπ'some rambling code examples to show how to use VARPTR, VARSEG, and SADD. Hopeπ'it helps you to understand better.ππ CLSπ s$ = "test"π segment% = VARSEG(s$)π PRINT "Segment of s$ returned by VARSEG="; segment%π PRINTπ 'π offset% = SADD(s$)π PRINT "Offset of s$ as returned by SADD="; offset%π DEF SEG = segment%π PRINT "Contents of s$ = ";π FOR x% = 0 TO LEN(s$) - 1π PRINT CHR$(PEEK(offset% + x%));π NEXT x%π PRINT : PRINTπ 'π descroffset% = VARPTR(s$)π strlength% = PEEK(descroffset%) + PEEK(descroffset% + 1) * 256π stroffset% = PEEK(descroffset% + 2) + PEEK(descroffset% + 3) * 256π PRINT "Offset of s$'s string descriptor returned by VARPTR="; descroffset%π PRINT "Offset of s$ from string descriptor="; stroffset%π PRINT "Length of s$ from string descriptor="; strlength%π 'π PRINTπ DIM fixed AS STRING * 10π fixed = "0123456789"π offset% = VARPTR(fixed)π segment% = VARSEG(fixed)π PRINT "Offset of fixed length variable from VARSEG="; segment%π PRINT "Offset of fixed length variable from VARPTR="; offset%π PRINT "Contents of fixed length string=";π DEF SEG = segment%π FOR x% = 0 TO 9π PRINT CHR$(PEEK(offset% + x%));π NEXT x%π PRINTπErika Schulze PB XMS ROUTINES 100775.2275@CompuServe.com 08-24-96 (12:03) PB 249 16316 XMS.BAS ' Load/run under PowerBASIC to extract XMS.ZIPππDEFINT A-Z:SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"XMS.ZIP",4^6:Z&=11938:?STRING$(50,177);πU"%up()%9%%%R-%&Yd=Fmf3gFj'.%%f)%%%/%%%%wj%firj%SVxyIzx,>BSe5Ku0]πU"x)Rd%USVc_]x(57jz:'yLKZcTR-T<Zol\BDFb?(hU>pm:BKMHFEFk5oK8h2y4<uπU"m1C,G.D2dA)^Fd06nbYs^Hat/1_.RZ+lumoi1BfDs\:8jWC1N$v2q>_;0IPFy*RπU"\WekMYhC\aQqm9(CO5,8A$JfSh/=tt&mJzRq8Y4vdrooFe]T.9SaY+U;<5tB]<_πU"vrO?<tWik'D<Jf)Fz6sNJakp)+H7f7(Dj\jp,>I:UbW8hrl1V>^:08HpO<Uhr6bπU"1/wz8n9XtjaTCPb=3-(Hk57'&44&UUMsT;64i-sX)I:i#R13oRt5fo;0Y):hKojπU"%+j6ftT^v3oO#.z.Re/J<Rs-R+*L\sCiboK-^1Ir%#Gq&<V'h&V_f9,Mf1?(QEZπU"k+>hqz[;a&%][wCY87e89=G(K[R6PNUu00sVUi)EM<<=<BNCe#N5X]hQErTrAD7πU"GVRU/B9RfXfOT1:_XySJ-_jv=hKQY>'kJ%+G[<(O1#9EeQ.?%DBIKkIS#Cj&.kYπU"0WWfabjWHuvS?]d^o.Hf.Bv)U([r<5yYiA/\EIt'WFP=4QFjQoSN-M^rkDNw0CsπU"4xtuFG*;:dfJy0rJ6<&fm6Ka$/fNXoGCiT;ZFi,f=+/opmjIUMkr6o_m#5$Qc00πU"1Cd)I8X:*uZG?o-0?8G.;sO8f\CIUuw71app7e*qSYSA<_1Cf?hVtdnP^rVde-rπU"9i2b0003PSme:>r0;\8[=\STY?d14.*;n6,w6.\a,?P]G*Jh$>Go#_0DUq2VZ9RπU")<IYS<[kc.CiDl>w;?iUS'l#_d^$jq?5RJ7WLsbtQ:LYVVVkTiv0)$7UUTkZg(KπU"N&u%p()9%%%%-4%&Y=jF)vn-()&%(%^*%%%,%%(%'rx%SnshK&y<>]SU5wm17xZπU"+y&WmGrSDw8y'R;X:;=ZAoDBAp9^='fG3:oidJEQF)ejdPitC]XDXlkXD$=<PBJπU"8Z3n3M8ILhGNNq9\9Hd-d[u\]ZC+pu[=5..)R8$P6,90hAzCoaO^m?j<jfvQQrAπU"A%PxbkKtVLC2N?2=0:-=Ie*_#,kiUeEw62&V4C<#v4i'\r2)ad&uo.9k.fJcHm>πU"nUp048_D_^=9BGs7NFIlENDZcHS=[K#gFxPNshCdvMHP0=FQs/-:N0xRS6K_OXlπU"?NC=[sqlF_slMPpHqzYJ]6aC>d3zq\H'9[_O\'mIafq'lW>S$[8'd3;5s3XmP%*πU"^M<Bd&es>2ejBmc7bb+J*=?Eh\VyMFkkw*au,9;MLcYMBQ:Nc5=WFVDIINhIk.vπU"*iPk8KN?\Dg\Z&&L5o$0rV?IVfLTh-XwinfwD[Gj',>T(jI>iUEDf$Z%b5OvzatπU"0D-xfX/%vu=d9=r_Bg0GN8V>Qx<oAce1Xe&629FL,K#w4XE][Ml/$Wr2]sd;nt_πU"3&%[_-Lic[]GaX$z[?Dw(%up()%9%%%R-%&YR=F%R.Ld^,.%%y6%%%,%.%%'r%xπU"SugOq&f<.qy&?*#n$X+1(/>^+y6AqpYN-Y]-)zPX30c<ZtDUdQ1oJSy<_QU86g_πU"hJ6w%1FZ*rSoxD'W&=diumK3h<V=VY.FF<nVY80,4cgvrHv+[(-\3VNW?EL5To^πU"$htpp[via$Bxl$unXu2p2$9>0\dJ6s(A7%]ve84-d$)]+,om3+tuJLf.7uxl>Q>πU";ffAF-m;UnI'VQ7P_I:fc0/<%:12)s/*JOm#-93Le>>wu0<XVuSNRVA-53T*v,jπU"=41sn4EnYk6VFwP\1yFN5kuCo]gy+fno14dIjY<vO8SxSuPQrD,8X4>9,\*&jELπU"r.dOZtmL,2S(RkFgNaf&\\dhkEqR&D>8dW:j?tWDtY9rnVv[Q+r&T'Iv23bvmbpπU"14S)(o[wHv2\azebIioL5i=PWYVNM0:ZFAL,nFy%1]Mg>HEvg5:b)rNTS0iDeuAπU"\N*2Y&q85oJ6\b[0im+2AF]W3%Hf-0)_es0>NEkT>k8V(D$]psJVnhqL[9Vrl:?πU"Qv1'259..^]i;,6.L*&9_%_J=]o>E4+_pM&*$x2cQftxqVk[mJO$**$3gQCh35yπU"6V?FvC=B9#%hDR>ke4cew<cTHBH9ZYUi$pSLDxYq542#>^T)%i$R<kK<#jHXT9bπU"[pc_O.aBN,j8FGtTO5?SVb[0HqJvTSZL-qQ'RApqJRVj_WD^E3=3fa-1q96dx,-πU"^lH;dh0?o'0iHKOOt5CzALGl^qLAsP+h)yB_ee[4XJ$K%l0])SYX6V=uB*]#7kDπU"Ohh=x/b:--wS%4mpO7_?OXoUbDVC>CTp8B*dh-%x0p#\pU?JBB-emb(KGDf#.aUπU"7;?6rw;6rsyepprrIopH(RXT>RwGUD>kAb\O^>w4Eh_A>14:4et,];&jS%.rq(\πU".g;9OpdJ6n;bI&=Y>L%_WbUn^$nLtwXZjC\dM%1)c&Ur&r:p7n1(x4HNSD]B^EHπU"WA\1N$I?6K)pLtuA3;79Z;KI7N\\)8Xvr,]PtwMK2*M_kim+D7KQuB=:Zx1iK&-πU"/wAWi<nbej)(66Jnx1lI[2/zrjz_N'&$Na0&e=CsS8=ucnQtqRDwqOi(A26RC_]πU",+5/7*9ZWM(9EC?'L7>t8:&Hmmx=lIHGI.j&n7oW^y#ytWKdqyC\0+O^O%6[YFJπU"-C.9%a?vYGnPPU5%lpv,lBVr&$H8Qky+c']q_N3-&nE4K?9,6TB8+Yp<Tf=pFGiπU"R[c[K\QuYz9Uchqy?UVq1QB*'1P'_b_?o_W8&6E;zC:uLr'*=sYMNpW>Y];nM$gπU"lo[Wu23#:JmIKXM,uLd;-;_Joa]ZdLK3f#5qXQ..X(xgq2>JHQksD)+]jHs^C$&πU"tq.f<I*D%ALSN9c1].R:gm[[aaoK1-R5uPyiY*x+fQE^Wc_)2n-a6s8c^bwMHJ]πU".BB]Oj9bQ14iQoqE9sc?qOkWB27ipWxcP$.7AP1F-*Vu/^Mhk_b26&:j=K3rpYSπU"KMhN_jJKr0[Wkmnxnj9;$'[j/3oz*XxO>rhCmKT*B2FZO[:3uE##:?c#o,p>Z^EπU"TDk><#CtCLGWexUY*&U4vi1]^LedvMO2giY4LNiH1.Yf<+iPL^nrYr.[uBxX*_9πU"LH%:X5d$Y0vK;eP]%(eiRf)P5F%$K)W5z^q'<EV%T)-LX*-0/,Y*#VSDB;9N-dRπU"Q,>S4bg&R;eiX*TtSn/ReIk'hGg&k0e,\*Fl;s\RoSR%Xti&6;WslR9s6OhFq%zπU")wG//_Sonl,NFJ%dhf&C06t:/;;<sZR_sM%pFfO60VP'.i/BCwS5ZGGGmW&k3+uπU"wK\u)hl_\_DE/erCEd$(uQXBQRNoSQTe#d7:x4=EGZ#>>.vqgSZdt'sC,/Ut.L$πU"XTcD^Na#9/F9[(wxcu5piM2O\ThkIi8Kq[a,dIT_aaI$m'ba5pk+.Bdm3gaKt#wπU"N.8+ERh7%I>Kn_$sn'k$ud]+KBdn*g$]BCgymmaKRlKLlq_k[K^tk+[B,I2._KnπU"BkZnPFxAKa%BI,mBsnsa1qa+I92s+e9+qkTAa,It7SF.I#rI&aK<I#a/fu?zM-BπU"4040q/4'u)9mr;nj0TC:A5$h+f_Z8R*p9HoicJZb'm_,+_cQWsAHH\6bnVdnN,cπU"R3xGkT\dR03U>;PWgst*Dz=xEQG$*I<P-?4f/=hYX*[(Hf&92W,sukR,;''l?W(πU"$sW7*^q='2(kk?F/iUv%gChv&d,EURPZp3L?$RA4&5+U89iRA-(AT0]\pW*'LHCπU"N_\^/*s/AA4AUEPep*i24V*i:ej,,APBkS\R0/'^KB+*,ndPcPhU/HQHpd>TTZUπU"6/RA2Y%'90pa2D.,'2TJ5rJe$G;^c_h[5*g*-d$Tj>4<2Dz%s$t[6/UMJ%=nY3-πU"QA<D%'ogW)<2<T%gCm=B/U<0%gKU=,/+k8.T4.+k^RZ0VCtT9-TA64%+5q[R/U7πU"FPP%$?$l2;A'IQbkq$pV>n4O?w-sd%up()%9%%%R-%&Y.=Fnp>g(\'7%%<,%%%,πU"%.%%'r#xSy'Cytz*+tTU95M(cdr)vl/IGfcAO#d%sYe+.QAOk[\:buG.MGsEEreπU"C9(rX#KI#5=yjq.yQ$rk,eL%6nq&I7YQ3M=t%o=x)P-#^nJ3LC6?KA:vJg1eWBrπU"8F5^M\3Ojec;6sp(W[[EgRc?XkuhD5OsHVxmW[G+dW-]'svUiBZO,D4eKX7s#%UπU"c^;/Io:]/dr5m3QPim7+)4%8)8<;IP/E<NVZN-h;fUPP:/?%-1(7Aa0I_(z>q?mπU"JsZ\fZO'bb4%P1lf<6-OU'aVdng7E;Nrfb^kJAn4lg/.16d4NeBRdnU_6SqIP\hπU"U$#pDvVWOi&%F>+eA;&W[j2x;huf<eGEk=oW99A>2\ga;1>9wt?%:-KToNzb\WLπU"M7RK.x#EYqj*#1Kx1cahsPha[p,)=2_%SN-,As;j<3wl:a7uhpYm#IdZ<%k-GtKπU"H-*O&Qc>O$:yk*IX0R9($PPyL#/pHJQe+Jd3Vb?-/GP\ZQ&l/D_m7Yc?&&[A_R,πU"D7#9mQ*mN\OHD/-cRL<D).N%Rv1g>H^gC:5V,tp*f?aUDYt-GetkIR[%*p;9&qeπU"$8kB**GgLoaeer+UE][T/tA%gZ-v5XSdp\'$wGdU>dp)mFKgNo/:**IR1CRsEa2πU"H#g-YulfnD%na1DtTIifyuftibR>4PsK.;t0bjK7G2Ak%KV',WtKn.IlJFcSIujπU"(Itr(2$>]ilrqdvdikA5^R_=Ac\U)3_y-g+\^9bfbTYG^cQU%7)8=8Nd8=W<%vYπU"M(m9sq#b2\$Rl<?*;[.TLu#T//F'4/K$=,_W9t+KH-8OvQLMoDTLgP0XppRh&V'πU".?RPznnomu^aorOFQ)VZYr7&Jtnu.6K9:baWQ.r;i-ar'z[hu>,E%yXQLl-g=#)πU"=w(5Z?RO+jLA.N:d]Tp>$A^_1^9vFV$S;5Qerl:i\DAK^s.r7<PHl,%up()%9%%πU"%R-%&Y7=F#u5[Gf,.%%?Q%%%/%.%%'r%xfxr%SfxrEN)p>'T]5c7Xew(mTj/&47πU"Q86MG4GZjaJ/Ze3vvQ[9j3+4j#9JmvEb=6b(.37No-qXN/\C18-kmQ<Z?5lqFR;πU"Yd*ppDBOBrWT8:j4M^Qr.lGqNuXWSW:gWE)FpJN2/crQYq[rmO7d$u'^Tza+0bUπU"]k(=.LaG3JB0J\I6[h_IQDM[sawGmY]uAkYuo+c6HEu^BZNPpvib3TSs']Xx;[7πU"NLf(*<B,m5Fe<0pOQQxupkDB0[WYgHwG7m[)dMlZjJ0z<L53M)LS36l?K8[q:afπU"&Ci=g(p)Tpad8g,rAAm=u/2aK5_S2fj)W54E/As$qH29hQ]BBn&$#ksR2W/4he1πU"bv\%VLg?V-AC8\UVBv#YI;8dMjXKL%krhJ^r'0H/6:SdFHkDU,p_yS+*$^c00Y$πU"PQhDNRuQ/7gqaUC(t^Tt(sfYWG_gQyOdYKi^5[lU[,/T][cQ+E?46F2]Br0;$jgπU"Wua46LeNa??Mb[P=6arDKrZ6TU_ZUG7-LA.l.5-9PdNJU-BO%0zO?xmDl]#8Ws6πU"B*g5)T*fAM:fr2Zur5NHSX#K+#YE2A#m)0(nc7r2kBzQ4UhVCkex?Y_en]YQ<A,πU"3XbT,4R$t,xUMT4oe17t0PGFl-:sTFSGgZC=h08r8-%&jafV65djIUz^h%DDYWOπU"-]%i+9cf7PLUlQa]AOoHT'ilwR65W[G08LdzI&H?a-M*#PX+EjXWGH-qSpkF2Y5πU"e^D)&;XHWB%tx::\La'(;jB1j[[vOM6hwGWHp5P'Y_k*c%xuQ:K1]Bch3)OQud-πU"%B%+K08hL)ktkRa.&hYB-E_L_+<^dun/C]6kh$R?U,IJ25MH(NXzNGJi23b+;cJπU"pqcVfvYd-RkAXtc\/x#W>P&kfCr9SAW6k-4C49<CVsOiV3QZ_utX<aT?#GeUKM8πU"N]\6,hZ3J66\$E/(SsuL'<%/4+jj_w_J?a8(;t]cKe&5(j.M5tfH^U\(&b<qCqtπU"R%Ba0[La6':uwtHf22ZYqf-6n1(=hBiUYTC>F?(B[UGI;fXst0/6NZVVUG*_O2>πU"1_-J]X'oBK[AC(xldw/07t7CCts+jXml4;2c_h.*gsXe[8e,>WGk'amRHMG(HiBπU"f#:.s%bS$FpHVSF&Sbrjm/X_gY**[hWz>qEmI1UbZGBrwzI\-]hVt?_pMJNu$$dπU"YI075[kU,KZM):eF2';)r.)wfK]/0hSZQdp/;kn#zNzkC7V2fCes^^/G:WYiqI3πU"3O&q8r.eIS3;2xD%a/a%GYJ'Stf2y_aKtUJN2?RJ=k;vu)U]/U2&[RIg^lY[A[jπU"0zB>p$d'-qnf5iQ<5R&<N-?+_Ky(s2<E\,]PT2Q6wCr8fV&:S1?]l5H2.>CFAUHπU"HlxI>JcFd7aGMJI(2C:EK8u=#gnPiCg36a%?6u?0gB(D&TQNn#5hghs)$rcf'3[πU"V'(g4w/]dHP$BMb]>#=HP$:yJG0*xiMw1]g5%.rT?q[)ROlJ6)NQPy$*yKiy]=3πU"?ooN]Pp-$':RNj6N26XrOj&i3EBlJXXNn]P$5k)=a4(Kq'wG)FRrxR9><+#]%>TπU"CV/PI5'kzyS(d-Zd_Npv;6-k.o&q?S0cnZ1SN=4?%^5<\%)j1iu,fZ;vn1(Rfi,πU"qLs:0h,k'K5NMNO?^-L_k)AftptG.zDLZS7-P/?qB<g]<&63bK80[gNPu*Ks4=pπU"H)7akRWwXZL[77A2jmm>1k[w8$)sUKl3QC=-lkmuj*F^FN%LhFN=PV3JdXL++3QπU"mlV<s_=O3x0.6B6<;s,1.pVpeA78c/BSArawY0B:,#eMo#SAy=N=r]A^?#4+3R&πU"0qA#0-=CyLZb.q=RF:3=xlWvI]+-1;'0c=um0WQMGgQb&S5)LAsGx]7fZ^/&9MzπU"5&F,TY8k>EP(SM<.a&QggC465t4?aOF#TeyVPs+a8.-vW)u3oaU/oSPCskf&,s8πU"1$;iK?E\dnC=K-9M]m'.o/55?WZ%nDpg6ptavdHw9:$t=N&xW7s)rM$r>-d)\DFπU"oZ;'+G\pD>+aPcurnA6PN;Nk+F3W[=W2<o+8mw1u8z0rSnH3UkiQZCkjj%b5fcOπU"ls&,$cBDO\#[_w&%)]_vSTXHrKQjef%6+i'T9niA56S>a5Y?/D2[LU?JFIzde3aπU"rNN1oh*6Pe/(MeCTx^dt#&f+QH%tRLJds4QSQP,fFxMPf**frX2$/l9TcpM;.6BπU"5Xt^gD0C:WedjViN:+ss;8QXgVRGutrU.dHcUH>mZkf'Aa^YWzN+n;NHBd[3-HwπU"P]y4$+Mk-^',IT<mc;3E7QNQD,?F-wXy4Vsjb]Ak)GOfUI9qPW^dD4lM$z_86o%πU"o5xP7#j_^.+AL16c'kiUi<SjqLuuR%$Wwp^.GVkT-]Eql7pjHHM]MXms'bS)ENiπU"Ez94&DSEUz:n.-OWOAr,V,X26KuJ);ANQI'G,]v/R-q.O./6*_v#F9CrmL,Az.>πU"&c(S&zouR-nx%u%p()9%%%%-4%&Y=+FimJ'%7'%(%s'%%%/%%(%'rx%fxrS#tgoπU"<5$::8n,9>H\jqLLCI\FSDO7g9/p$*I^S+yaJ_qu$dIHbbXiZ,pJP+Tu&TI*fB=πU"/S5)kQxM$NY0f\.65TkOL\S[dhu[7g5reh_G.[sg=>2uUt4$i6FURe]EC0rN(f-πU"'_m2$s(Y52NN=;5ecs6&NN'.:S6WO)N4B6BgHBHg$KPB#Z[$(>O7LNkFPS&Q_tLπU"&1QFT&JNt0WHB>yk4*_(5p[n-&oPblkmJ&l4iHl,qkk/XF+&gw2h1\ecoT7y%7/πU"gUDx7Nf7vN'ed:T3VgYF:cIA;%eD=AIVegCIm\Y_e9uo&,ToM2w.&PJS<O>BW>'πU"A3's&zXGd9L%TqiQ<des)#]=Doaz:uN8ZeU;W*GAED.u=Ljs&VUZbu;EY&k5;;NπU"?'<,rj]+4L.r/HRwU40H'Veq^pw7^kZC]G0CnQr?4pDSgq3edYqTtY,RlkJ3'RwπU"Jl+]PGCf^4XkVvGEdl%=;E8VhYW401Pmpf^;.86+e]773=*2b)3VQC:MG?Pv8BYπU"JRB=ArAC0#lb>,JJg)3ZYB[RWml+vuboBUA?hdHHBm%x5Pa%j9ZPIBaq&tHiierπU"8R%MlXWJJDOnYhRdH*O[dPVJVnvbYK=).p8uo3N9*.xd.OD%RE_>58ebCAseWxVπU"aLC$vs'xndqeE7q>fB9dL?1>_DoLTaw%'up(%)9%%[%-%&AY=FIr7_ck%'%%y%/πU"%%/#%%%'%rxgf%xSgf4x&ev,>[]5DOn<XTxU&%pp*bgrQE0P2m=F:.g5$'RiegyπU"MJBbPM)D;3s$-utf.hw/'$)uzddE2uSL>H3R7cs#R'\VzkjdEdK\EiG2BWv8adaπU"LLc9%q[\H]/x(0/;,afXQq&bvAkR&I\?<W=n(jdku_$Ps,xC7yN.Vml0*rf%$[WπU"vU*(JNEt_g4S6E8+*W_$%<sM*\.Dc+1&0:]a,)-,AAvN]+Yp#8'g7OZ-J%Mo9\DπU"l%G\XX<7&/*mH,[-/inppEHz-OjS9Gx0w3,]0gqXgM4QxY(%>=<Eh,Zv276zD]$πU"5L6=MmTRVO?iA-?rU=]TJX[e8]mx%_dRBCL?\iW:qYxVuQ<QpuURB3bz\V(hqqRπU"&H+#v^m'n*ecIN6VziHQsMi$Y>J,9imvR;o9t\qYu5b7%lfmRV?>2Ie9l:<Au2?πU"epoL?u,5Rxbv'n-ti^fU?L=KiK&Rb3W4603xi8i;+&C2+9e'Av7+Mhs:c&*nRa5πU"?YSpgqTpAOb<RQe*\0</$,he]>$?i\hO2_X%-uiI8segl:vu%VzxMiD5'TE:x8>πU"y(&07nT/&Cppu'D3ZReX(Vcp+\ptGRv8N=ZM.A#3jFIBrHTcH29>Y=W6JSV$aYUπU"+WMM#:29'CMlu\iW+AM<i:0THr&62X6\a7XnEVp<A,F*Am=a1\$%hrOS++-=x<cπU"%y4mG<jORrYBAPSlJ%AMCg=[6Dq_N%\[b4V2)9#\&r:S;:0Ts5?wN6XKIyQb6+>πU"^0rZI(\T1]wCRA6ktnM]=Va]Um%b<gq6$q])TW7[%9420]FpKacFfZL\$L^7^XQπU"m*9=C$<%Jb\YcCV>oC^Iy9+f^,,UjrM/a4t(/eo[ZwlmNUmj?'/&'OLL[pSG3MPπU"*b=Pc.s;0^?N;alyYzo;=5&R:O>+Sp39iG8l2(Fj)W\MnM/z;KTqYExH<eaV5X3πU"S&Ah219K?rfvk-4n8u%p()9%%%%-4%&Y=aFQYx)s(*%%%v3%%%/%%(%'rx%gfxSπU"[ugz&2f.79RlA#6QhG9qX7BV8'==KY8x.c[HN-/9<B8KK:YX:IA<iP=e=L#BuWgπU"*4#<27WdZgxQ6QS%uqS]Ow30%ZtUlxIYK/J^LaOswt+E>GY;qQ^_X$84COKGrbYπU";70nNX6EF3wkZH8(2ZMG58-pJW;X<ZTWSUEw>b7%4_:h.mh$u,/#oyP\;B\TPLQπU"#/u1ppKe5*ejBdqp#OpdJr\J\+fj[>naPSaH<n9je\&TCCX^b9AIBa3'I[V:pCpπU"Lz^Ir1n/i[gGE$FH]dQ2<m$exBVs$k&ovRA\9%1K:b1e#'1cdLfW8;=)w-rW>qQπU"#I&nV,tDuoJuAk)$PSnqF9QrvABCP->V[+9[CK3jI1#jm[ZoaIEm*u-6JhGI0fWπU"=10Si%CtO+76CPTrf6qGy%/b(eDD/E#Z_n51#%=KKCOA\R68R?.q6[bX)ch3YetπU"9rQ)Lb1g2iQA?G(LI,y^#),;/qrKDF,t1VTvFqHNOtzrU#>:(,RF4#_yv#Y1LZ&πU"0Y6A)<L\<Sb&?YvA^Lj&T8A-o(?D/Ri\V(Wn9,u'rbTee9E_nb=MU3+>U1m%CelπU"aWFhp7[+->\8W000Jq&bbU[maGm6(*LP_nkv</3EqtLta)/6Y;:LsXm<4)uYbn+πU"]Y32r.I5T;159).g#d2iX2k]48EN%L$(D5%9Cs[1s,t=CD8wyF<*L9STHk$c89]πU"U?</$NT;QbeV#aP=jQ,Pup==XCK;3s1ZW;^%C%#opo/t7Nyf5L?wXLf_kkOX?AGπU"EpX69ZwgQfc1ziGLK#P6Zf]bSU2e69QO)BZTX.dgT68Z9m2YRrdE<Sky[YF_eFgπU"2XKe$bZZi4UMl+5_YG[=G$UI;>TgzC.2KU5OjpxEE)qVABO7J2]]W76[2.zFj49πU"\7o%i0]_(SqjA06LqJFA6Tq%)lLi=y>J,pGy_aJ260];wWc]._Pq+P]GX7I2lnWπU"hwXrlpG9_adx6<]BaX6<6_aB6W.?mT_W)^s7wifA/LJqs,]7;v%4l<iuM#J0mG?πU"YaMaWEB_CH;&%l8w$M#KA9\9WcjXv>ZvBr$Z#231A'qx)\[]/B$/Eh7tDN0EEC3πU"8yphWfTRqu?/RLn9X;$LWC[.<1#w#Dx]cE2*S)wMTvAjZ2fWklli,ve1^JDn;rnπU"coeeFuF*w?J<6:aJ;SeH4u&NZ9%#E[e95.Zh(AP]28#&[lbWXEw,Qq<GQ'jwV9QπU")J*;$UAf(AT](9jB=ZbWXFg%giHa/a5zF9/emg15WR59#EGf;+Pq:9[K=d45lqaπU"S%e%T9Q+J4%V'V38#'[a.iC1?f[4Wt.502aS%g%V;7RQ*_$P]EtQ&Ct0*'yhO_SπU"S-[k)*aa#m(TUrT;ltbEr48_B5vlG'B.bV.<'Zw-$hQ$Wx7?34bk*>sDPfMAW_-πU"p?0ZYLZ#H3uC+_R24W6>MLfgM\,e^&pgrzL^lxkCbjN2FDDP]:yqunkxhl>aVsuπU"b;,e6dtrm*Kf4SJXIlNYzr5*+pV0c?coW(RDFib'tAfmm-)*cSwnIB+0.WofMmbπU"hog^l7gbpBd6bF-&wIV64hK_S%P665e\lUM%HnHenl7MlI-a,a0[gg#c-6leFZIπU"7Zo(jio=9-XnbfaB6P?<D%I,4*hgk\sO6L+RlY3(ib,c6.R?<vYIL+fiM7zKK4RπU"JFL6<&I;^3h?Dqlo>9ZwB$hR7^K;:c6ADqLo>5ReDFU_omEEC-bq<4nmOjuWb5jπU"xZz\3$.1-<w:nD%up()%9%%%R-%&Y[=Fv?5eCZ/7%%$F%%%0%.%%'r%xijr%tSgπU"fOx>(*,F[m3hMUBqg4ikB_<iU?dK\5RA-SsV)<=,mt.o&)X0i?E;#ye5Q_P>x,KπU":sEklEsH0s*2n/nyaosJR#8-6XzOCC^]*>?[N0QXsb]KRD%)oF.5j1gk5=7Q>(<πU"=qgU8qg'DI$vbg4($xhz]LSTHQD3MH0whggsFx%d:,ctY#muOWKkTZH\zuuw7ePπU"k[4,IeIW#tKa(6*xSP&L<R=vJZipQ(aS<)5uCTOs)S%vp7Y+E72X#?mbv'2*.fEπU"6hgiI[LLw4nObcWWHEu8vT'Ir8u(Uk$aM6BI1<pa-]oCsu677JO\+W]LHw1T6IwπU"Q6O^r=OrxZ7RtCV[Orl:B>;;TTUiJPshcG\pf4Ii\MZOV%fYU.9Dk#-e+9%]xuWπU"-O?5JT%OcwSCVN:d5+A,9/TH\QO4)tIM>q=I<_R9k\0ZTeU\arBZ#7yEU.&eC2AπU"+pk1lrL=8t%D8KHHLeEa+lgN5au%;,^N9?o4lVm.f_\BDuZ\X,C#xyAtCEOV+LaπU"\l=U52fpCnZ8UaHMYAM:0AUEKc&tjG;>qQABWcd/ecjq);_[D,E;<NYj%m.GZrZπU"MEabZx[$56g2hc<xQH,cqqpsceOA0XXE0c)*pp8X26JCf0:7jJY$'5Y1Og7'UBqπU"XpuY1[gYoE=mO>FjeG]UOWi=IhN=MW?o&J.gR:OZkV;/?K,jirOXW1dji\=Jd7$πU"dmM,F%mU/4#MVT#We.W0KePuk2DO[t=LL>5tlC%0ie9(LUePZ=R^T$726U[/U0$πU"5BCp&hi3iYM)oY+T;H'C&,%PK/SXBJ770*oUOM]l.o<L'.hl=h>VH&rPOcsBF;YπU"v^ex*F7U4iv=k*rK\%8tSwori=b#_AeJsUf.?55lBKSf'gM_g#og\NgF),x^7s;πU"dFg_EL2v]drwv9F(Z3$TD:xnsgIbo1F_=ddaV9Pbva[E35T[uAco&=<-dmQmW.3πU"qZq*jtL^mgn[sGNffmYq*Kraq\,u\R2UHDOAm'E/Fnx59_&_5pjOdm5cMNcAfDiπU"u7..beu]h$4W>$OUwJ?jA\vZ<IiYkyBr\2Tmy(mse2CT*wJT[+=vo#b5\sRv&/WπU"V:T'3Bj<=[^w#RR;9)=L.QsxTC:lV=[$cf>>7%[h05ZK%MFF+]q*St;/t#gxOSNπU"b9^hz86M#%xmWPXJway(TdPsOw+cN'0#R&L7_WoGJU&W1Q:\6MYLm#:vC,wH1NcπU"%d<nVhcK[9DwJgW+T]ZB3JF$G7NIfGqSzxi]q=dREN?4iV]dSG$Kw$S%#3urNxWπU"I42r2YSy<kv1K,(O0G6ISfFZ[CCjLS8QPq*:&+?:B06cb;<'g\,m=O^p[:8s-AlπU"J.5Os)AX7Tb.eULu%(T24?dMCDx'$AXPwJ[avEpOl<S7RSRXi;tq]+r>Xu)$?k3πU"kBUfpqj[-CIZ9[g_tiMtV%c$Ci5BDaF\4(Gkfd6-a.Vf4,FPV4-7nL:_HNE60[_πU"MyQb^Ng8zH3y,;pKvE&FNX4s]7d_dY\<.V]V2(2uhUP9P9zHJa-[W0u\>,^'w6?πU"[sYAem[k<Lw#/MSj'WcbYV#q0_.j$^4cD;-mOAmjU]%k$Q>6P&\P%'\P_y0&F,BπU"J(/.M<\g*^$sBujaU.^uf<j^HJsKZee\xyQZ3qHXCBZ0Y8^Sf4KJ<UBh)DnmmitπU"$?q$#P_7.3WQx4KF&7$J0+]&P]SC%2M=E.ZH%Oki6X2_6lHG;sgp0/UPA<d]'^bπEND SUBπSUB V2πU"oQlMGjUXEtb58Wr:cHCxMP$[u%mb0NY6OeV0QRIjX(?\pLkl;kBG=0/B<g317H'πU"czdGfBI+vBgJIxy10I:rS9D,R3CS>o>El,PR(Q=:A\3U:H#2v)xMSkdb04Hju_<πU"fxMPer6l,cgGM=bo<:n,4as9NAxcd)Z2;.+uM6.bzC\>j'xOcE2eIkq9DCY<EPsπU"Q8+Q,FkbK8Mlo=5;=]Xu'j(bh$ikx?e8xgM2Gu%njEl9Le2Y$%=qA6Zq$=\4Og^πU"6-MI]$k),P4n3M7d>$,isfO<v&cl#GBz;2;0dgSeX](>L9.j36?)+-wA:&F::cJπU"/oL8lRwst^E+%sJ/YWE=n#(3SLe6gI8(?ptom_;fdNtgg2$vwp+bc,Grc',NsnDπU"Qn>1+?sBemM;E$.DPlCXY9Sm%Q(sXWcxQ6dKDUyy2wP/gz?t;<lMh<2SZ6HvUluπU"Kdu,'#6a,3u=mm.rt;#T)Z%8iSLybF\cztWgHazJ&)#TqSbgFK]Y,e)I4ieX]WCπU"dR+8XeMZ^j30[Sg?B?PU,d7QD=g/WjC/1RA*hRJn&ALE'aOKn'w+[.'\;[Rm]&uπU"ieAM&sqySmMr'[*-?FQSm$oXNTK_>OOZKTKT9KVoK,-[wsPIE-Wr#I-#09Jf8xXπU"SCf#pm0+Nd_zzW%gO?,VCkBiln/fvX'xBwS>N>h847'7kajs_>dJg??059Hi8G%πU"V/RqUGZla)FB.'+C2HXjR+6ns)T,R.IP[>'&$rcw3Qrc=GjBuw2T%l;9pW3Ilv3πU"/[3:XpbGAku>P.H\3Ur(NQE4Sa\g9-/>bzD$i?l''PZ<^6N(p/C(d/ckfp'LnJ;πU"ip(wcbq:Wo).\ARvl'gHF/h[*;;B(Ajhkot[IHYO%,rJLe)v4+J?.sfYN.X9n]SπU"Dlk*7Y$i(r1]S:KKYW]/wlLhna6%;]v\q]K(L,Y<s?vG2pkATxh;&#YH^/1*Dx:πU"C>lDdSc)9r+Tjn:_MRlqm%X5RKA#)\Kb#s*a.VsaNlW]<:xq.w0&Nt^\/b&O(8/πU"b,YkIfS4cPn(WdfHP8\)QmDO\A?ag08sKUmPBFe.)wSe%NA7e.Vslal)K1Wwu%2πU"J$X^\T8.pa&UW%e,]b+GvQRa,DMp]b^Mz%egM^7&9ZCR]nG]L]5P3Eh^\nM$?rwπU"*)4iH16ii=/4l0UjlD.;X;^>KQT;zXagq%o:L.]ZvM*xH('DCQlo0iL-<+%GsPdπU"^39rTmo13vciLGrbXBn?xf0Av/L9+%F>yEV8u=UuLBqtvLgT:as<.;vEGCDLvbhπU"fB\>FHTm>?>aGB^c&?s&>hRt,n)^FbV4M9h*d1rm==HDlW0)S&*=TUbM,ri&Xb#πU"uWgPqe'\Uc+cP2Bb1F$F;C5n&NsqL%_6:ys,sRtPkEZV.+mP?5AbtkhBBEVjI<uπU"7[W$<^LkHM:E;$]lbN2q6Ze-b6xSrS$fHErAH2oosB+LMgv>gV-:CmiFB-7tIv_πU"RY8I'&t&HEsKj3jf;^=$djm],tdQ;84+qIlt=iCGWg(C=US]+Jfo'bld4$83h=PπU"W$jfTtGBcoGDP:LF&IhqNB&\W[J[*7-ME;oOI41A&T/UdS<aDWw_yrO'N#iC=c'πU"'8/(.pX/:k4TSTU'<Uu]2N2H-/BLwuE?O-6_kT7dLzn.MZ[P$;fIkF&P-0\llNPπU"*uG?SBKs[8xSR]u(S37iRsN-zsWu-[evT'wjN%up&'%9%9%%%%-%*&Y=FYmfgF&πU"j'%%&f)%%%/%%%%%%%%%&%E%%%%%%%%%wj%firj%SVxy%up&'%9%9%%%%-%*&Y=πU"Fr)vn(')&%%&^*%%%,%%%%%%%%%&%E%7%%<'.%%'r%xSns%hup&%'9%9%%%%-4%πU"&Y=4F%RL(d^,%(%y6%%%,%%%%%%%%%%%E#%%%g#)%%'%rxSu%gqup%&'9%%9%%%πU"R-%&Y.=Fnp>g(\'7%%<,%%%,%%%%%%%%%&%%E%%%%q1%%&'rxS(y'yu%p&'9%%9πU"%%[%-%&\Y=F#Uu[Gf#,%%?%Q%%/%%%%%%%%%&%%E%%%%y4%(%'rx%fxrS%fxru%πU"p&'9%%9%%[%-%&\Y=Fi7mJ%7#'%%s%'%%/%%%%%%%%%%%%E%%%%8<%(%'rx%fxrπU"S%tgou%p&'9%%9%%[%-%&AY=FIr7_ck%'%%y%/%%/%%%%%%%%%&%%E%%%%r>%(%πU"'rx%gfxS%gfxu%p&'9%%9%%[%-%&\Y=FQOYxs(%*%%v%3%%/%%%%%%%%%%%%E%%πU"(%6A%(%'rx%gfxS%ugzu%p&'9%%9%%[%-%&&Y=FvW?eCZ[/%%$%F%%0%%%%%%%%πU"%&%%E%%+%aF%(%'rx%ijrt%Sgfx%up*+%%%%%%.%.%'i&%%&kQ%%%%%πEND SUBπV2πCLOSE:IF S=238AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπCharles Godard OPEN UP TO 16 POPUP BOXES FidoNet QUIK_BAS Echo 06-24-96 (00:00) QB, QBasic, PDS 274 8798 NEWPOPUP.BAS'NewPopu1.bas by Charles Godard, 06/24/96π'Popup boxes over boxes; 16 open at one time!π'<<<<<<<<<This Version is made for Qbasic>>>>>>>>>π'Many thanks to Gary Godard for the suggestion to use the ScreenPramπ'and for a good explanation of how to use multiple dimension arraysππ'No Border = 0, single = 1, double = 2π'shutUP by itself closes the last box openedππ'The number of Boxes% open at once, depends on Dgroup Memory available.π'I have tested it up to 15 boxes open at one time in this program.π'Each box requires 4000 bytes. That's 2000 for the character andπ'2000 for the attribute times the number of screens open at once.π'You cannot exceed 64k at one time with all routines includingπ'whatever else your program is using.ππ'This program will also run in QuickBasic, and you can have asπ'many as 70 boxes open using far memory. Just redim boxes to 70π'and start adding more boxes to your program. (depends on far mem)ππ'I re-coded this as a Qbasic program, because I remember when Iπ'was first starting out, I was disapointed because I thought thatπ'Qbasic was so limited in what it would do, that I became discouraged.π'(I didn't have a good conference like this for encouragement.:))π'And I keep seeing msg's from guys who don't have QB.π'Altho I certainly like QB better, there is still a lot that canπ'be done in Qbasic as many here in the echo have found out.ππ'If anyone wants to see the QuickBasic version, just ask andπ'I'll be glad to post it. (It's a little faster, and doesn'tπ'use the SCREEN function)ππDEFINT A-ZπDECLARE SUB shutup ()πDECLARE SUB KeyWait (dly%)πDECLARE SUB FastPrte (Row%, Col%, Buffer$, Attr%, Visible%)πDECLARE SUB PopUp (Row%, Col%, Widthe%, Height%, Attr%, Title$, Bdr%)πDECLARE SUB bPU (R%, c%, W%, H%, Fg%, Bg%, Title$, Bdr)πTYPE ScreenData 'if calling from another prog moduleπRow AS INTEGER 'use both of these 2 type def, inπCol AS INTEGER 'both calling and called programπWidthe AS INTEGERπHeight AS INTEGERπAttr AS INTEGERπEND TYPEπTYPE ScreenPramπChar AS STRING * 1πAttr AS STRING * 1πEND TYPEπ'I have not tried calling this version from another program, butπ'it 'should' work just like the Quickbasic version:ππ'if called from another program, use the next 4 statements in order,π'in the call-ING programππ'this goes in both programs:πCOMMON SHARED SD() AS ScreenData, x() AS ScreenPram, scrnsUP AS INTEGERππ'next 3 declaractions not needed in the call-ED programπ πboxes% = 12 'this works for me.. if you have mem prob.. reduce this #π'and don't open as many boxesπ'demo requires 12.. if you change this # be sure toπ'save afterward to avoid out of string space errors.πDIM SHARED SD(boxes%) AS ScreenDataπDIM SHARED x(1 TO boxes%, 25, 80) AS ScreenPramππSCREEN 0: COLOR 7, 1: CLSπ'FOR I = 0 TO 1997 STEP 2: PRINT CHR$(3); : PRINT " "; : NEXTπFOR I = 0 TO 999 STEP 2: PRINT CHR$(3); : PRINT " "; : NEXTπCOLOR &HEπFOR I = 999 TO 1997 STEP 2: PRINT CHR$(3); : PRINT " "; : NEXTππCALL bPU(2, 10, 50, 10, &HE, 4, Title$, 0)πMsg$ = "Show a box with no borders"πLOCATE 6, 22: COLOR &HE, 4: PRINT Msg$;πKeyWait 3ππCALL bPU(4, 15, 50, 10, &H1E, 4, Title$, 2)πMsg$ = " Same box with blinking borders "πLOCATE 8, 25: COLOR &HE, 4: PRINT Msg$;πKeyWait 3ππCALL bPU(6, 20, 50, 10, &HE, 4, Title$, 2)πMsg$ = " Same box with blinking text "πLOCATE 10, 31: COLOR &H1E, 4: PRINT Msg$;πKeyWait 3ππTitle$ = "Give it a Title"πCALL bPU(8, 25, 50, 10, &HE, &H9, Title$, 2)πMsg$ = " Change the Color "πLOCATE 12, 42: COLOR &H1E, 4: PRINT Msg$;πKeyWait 3ππTitle$ = "[Any title you want]"πKeyWait 3ππTitle$ = " Windows for QBasic!! "πCALL bPU(10, 10, 60, 5, &H5, &H7, Title$, 2)πMsg$ = " Watch out Bill Gates!!! "πLOCATE 12, 28: COLOR &H17, 5: PRINT Msg$;πKeyWait 3ππTitle$ = "[Full screen display]"πCALL bPU(1, 1, 80, 25, &HE, &H4, Title$, 2)πMsg$ = "As many as 16 boxes displayed at once!"πLOCATE 11, 24: COLOR &H1E, 4: PRINT Msg$;πMsg$ = " All open at one time!! "πLOCATE 12, 24: COLOR &H1E, 4: PRINT Msg$;πKeyWait 4πFOR I = 0 TO scrnsUP: shutup: NEXTππTitle$ = "Small Window"πbPU 3, 6, 16, 5, &H6, &H3, Title$, 2πKeyWait 1πbPU 5, 8, 16, 5, &H6, &H0, Title$, 2πbPU 7, 10, 16, 5, &H6, &H1, Title$, 2πbPU 9, 12, 16, 5, &H6, &H2, Title$, 2πbPU 11, 14, 16, 5, &H6, &H3, Title$, 2πbPU 13, 16, 16, 5, &HE, &H4, Title$, 2πKeyWait 3ππTitle$ = "Larger Windows"πbPU 2, 30, 26, 10, 6, &H7, Title$, 2πKeyWait 1πbPU 4, 32, 26, 10, &HF, &H8, Title$, 2πbPU 6, 34, 26, 10, &H8, &H1, Title$, 2πbPU 8, 36, 26, 10, 9, &H2, Title$, 2πbPU 10, 38, 26, 10, &HA, &H3, Title$, 2πbPU 12, 40, 26, 10, &HB, &H4, Title$, 2π'bPU 14, 42, 26, 10, &HC, &H5, Title$, 1π'bPU 16, 44, 26, 10, &HD, &H6, Title$, 1πKeyWait 4πFOR I = 0 TO scrnsUP: shutup: NEXTππTitle$ = "Popup just a centered message"πbPU 10, 22, 40, 1, &H4, &H3, Title$, 0πKeyWait dly%πTitle$ = "Not bad for a Right Wing Redneck!!"πbPU 12, 22, 40, 1, &H4, &H3, Title$, 0πKeyWait dly%πTitle$ = "Go-Pat-Go"πbPU 12, 22, 40, 1, &H4, &H3, Title$, 0πKeyWait dly%πFOR I = 0 TO scrnsUP: shutup: NEXTππTitle$ = "<<<<< WOW >>>>>"πbPU 12, 21, 40, 1, &H7, &H4, Title$, 0 'this is neat.. it usesπTitle$ = "It's all in Qbasic" 'the centered title toπbPU 13, 21, 40, 1, &H4, &H3, Title$, 0 'display a one linerπKeyWait dly%πFOR I = 0 TO scrnsUP: shutup: NEXTππFOR I = 8 TO 14πTitle$ = "More exciting features to come!!!"π bPU (I), 21, 40, 1, &HF, &H3, Title$, 0 'tip, put the i in ()πNEXT 'to keep it from gettingπ 'changed in the subπKeyWait dly%πFOR I = 0 TO scrnsUP: shutup: NEXT 'closes all open boxesππbPU 8, 9, 64, 12, &HB, &H4, "By: Charles Godard", 2πRESTORE Credits:ππFOR I = 9 TO 18πREAD A$:πLOCATE (I), 11: COLOR &H4, 3: PRINT A$πNEXTπENDπCredits:πDATA" Thanks to all in the Qbasic conference for the good ideas "πDATA" The KeyWait SUB is from the discussions on the Delay timer "πDATA" Thanks to *Gary Godard* for the suggestions relating to "πDATA" storing the screendata in a one byte string and for a good "πDATA" explanation of how multiple dimension array's work. "πDATA" "πDATA" Alex Wellerstein and Bob Perkins discussions on the SCREEN "πDATA" Function, opened my eyes to what it would do and that is "πDATA" what gave me the idea to re-code this to Qbasic. Since I "πDATA" already had it done in QB, it wasn't a big prob. to recode."ππSUB bPU (R, c, W, H, Fg, Bg, Title$, Bdr)ππscrnsUP = scrnsUP + 1πSD(scrnsUP).Row = RπSD(scrnsUP).Col = cπSD(scrnsUP).Widthe = WπSD(scrnsUP).Height = HπSD(scrnsUP).Attr = SCREEN(R + 1, c + 1, 1)ππ'store the screenπFOR Row = R TO R + H - 1π FOR Col = c TO c + W - 1π x(scrnsUP, Row, Col).Attr = CHR$(SCREEN(Row, Col, 1))π x(scrnsUP, Row, Col).Char = CHR$(SCREEN(Row, Col))π NEXT ColπNEXT Rowππ'put a box on the screenπFOR Row = R TO R + H - 1πCOLOR Fg, BgπLOCATE Row, c: PRINT STRING$(W, " ");πNEXT Rowππ'set up border stylesπSELECT CASE BdrπCASE IS = 1πbdrtl = 218: bdrtr = 191: bdrlc = 192: bdrrc = 217: 'cornersπbdrv = 179: bdrh = 196: 'horizontal, vertical sidesπCASE IS = 2πbdrtl = 201: bdrtr = 187: bdrlc = 200: bdrrc = 188: 'cornersπbdrv = 186: bdrh = 205: 'horizontal, vertical sidesπEND SELECTππ'? the corners to the boxπCOLOR Fg, Bg: LOCATE R, c: PRINT CHR$(bdrtl);πCOLOR Fg, Bg: LOCATE R, c + W - 1: PRINT CHR$(bdrtr);πCOLOR Fg, Bg: LOCATE R + H - 1, c: PRINT CHR$(bdrlc);πCOLOR Fg, Bg: LOCATE R + H - 1, c + W - 1: PRINT CHR$(bdrrc);ππ'put the border sides around the boxπ'Lt side bdrπFOR Row = R + 1 TO R + H - 2πCOLOR Fg, BgπLOCATE Row, cπPRINT CHR$(bdrv);πNEXT Rowπ'Rt side bdrπFOR Row = R + 1 TO R + H - 2πCOLOR Fg, BgπLOCATE Row, c + W - 1πPRINT CHR$(bdrv);πNEXT Rowπ'top bdrπCOLOR Fg, BgπLOCATE R, c + 1πPRINT STRING$(W - 2, CHR$(bdrh));π'bottom bdrπCOLOR Fg, BgπLOCATE R + H - 1, c + 1πPRINT STRING$(W - 2, CHR$(bdrh));π Center = c + (W - LEN(Title$)) \ 2π LOCATE R, Center: PRINT Title$;πEND SUBππSUB KeyWait (dly%)ππIF dly% = 0 THEN dly% = 3πT& = TIMERπDO UNTIL ABS(TIMER - T&) > dly OR LEN(INKEY$): LOOPπEND SUBππSUB shutupπIF scrnsUP < 1 THEN EXIT SUBπR = SD(scrnsUP).Rowπc = SD(scrnsUP).ColπW = SD(scrnsUP).WidtheπH = SD(scrnsUP).HeightπA = SD(scrnsUP).AttrππCOLOR Fg, BgπFOR Row = R TO R + H - 1π FOR Col = c TO c + W - 1π LOCATE Row, Colπ A = ASC(x(scrnsUP, Row, Col).Attr)π Fg = A AND &HFπ Bg = (A \ &H10)π COLOR Fg, Bgπ PRINT x(scrnsUP, Row, Col).Char;π NEXT ColπNEXT RowπscrnsUP = scrnsUP - 1 'tracks the last open box which is still openππEND SUBπBradley Miller PB WINDOWS LIBRARY bgmiller@midwest.net 08-02-96 (20:48) PB 308 8868 WINLIB.BAS ' These routines are aimed at hopefully helping those that are new toπ' writing code in the PowerBASIC enviroment. (like me)π' There's not much here but if it can be of some help, I'm happy.π' If you don't need them because you are good at this kind of stuff,π' help someone who is striving to learn. (like me)π' Anyway, use 'em or lose 'em.π'π' If you have comments or suggestions please make contact...π' Internet: bgmiller@midwest.netπ' orπ' B. G. Millerπ' P. O. Box 184π' Ullin, IL. 62992π'---------------------------------------------------------------------------ππDECLARE SUB center(lcol%, rcol%, text$, row%)πDECLARE SUB cover(trow%, brow%, lcol%, rcol%, cnum%)πDECLARE SUB putwin(trow%, brow%, lcol%, rcol%, shad%, text$, fg%, bg%)πDECLARE SUB putbox(trow%, brow%, lcol%, rcol%, bord%, shad%, text$)πDECLARE SUB lilshad (trow%, brow%, lcol%, rcol%)πDECLARE SUB putscrn(scrn$)πDECLARE FUNCTION vidseg&()πDECLARE FUNCTION getscrn$()πDECLARE SUB hold()ππDIM lastscrn$(4) ' make array for screensππCOLOR 9, 0πCLSπcover 2, 24, 1, 80, 176 ' cover background with chr$(176)πCOLOR 0, 7πLOCATE 1, 1: PRINT STRING$(80, 0);πLOCATE 25, 1: PRINT STRING$(80, 0);πcenter 1, 80, "Press any key to continue...", 25πlastscrn$(0) = getscrn$πholdππCOLOR 15, 7π putbox 3, 9, 6, 38, 2, 1, ""π lastscrn$(1) = getscrn$π holdπCOLOR 7, 1π putbox 13, 19, 4, 72, 4, 1, " Description "π lastscrn$(2) = getscrn$π holdπCOLOR 15, 5π putbox 4, 21, 44, 75, 1, 2, " Description "π lastscrn$(3) = getscrn$π holdπCOLOR 14, 6π putbox 3, 21, 3, 77, 4, 2, ""π cover 4, 20, 4, 76, 247 ' put some junk in boxπ lastscrn$(4) = getscrn$π holdπCOLOR 11, 3π putbox 6, 17, 12, 51, 5, 2, ""π holdπ putscrn lastscrn$(4)π holdπ putscrn lastscrn$(3)π holdπ putscrn lastscrn$(2)π holdπ putscrn lastscrn$(1)π holdπ putscrn lastscrn$(0)π holdπCOLOR 0, 7π putbox 3, 22, 3, 77, 6, 2, ""π holdπCOLOR 14, 3π putbox 5, 12, 5, 21, 1, 0, ""πCOLOR 0, 7π lilshad 5, 12, 5, 21π holdπCOLOR 11, 1π putbox 4, 13, 26, 66, 2, 0, ""πCOLOR 0, 7π lilshad 4, 13, 26, 66π holdπCOLOR 15, 4πLOCATE 21, 6: PRINT " Button 1 "πCOLOR 14, 3πLOCATE 21, 21: PRINT " Button 2 "πCOLOR 11, 1πLOCATE 21, 36: PRINT " Button 3 "πCOLOR 14, 5πLOCATE 21, 51: PRINT " Button 4 "πCOLOR 0, 7π lilshad 21, 21, 6, 15π lilshad 21, 21, 21, 30πCOLOR 8, 7π lilshad 21, 21, 36, 45π lilshad 21, 21, 51, 60πholdπCOLOR 15, 0π putbox 16, 18, 4, 68, 2, 0, " Description "πCOLOR 8, 7π lilshad 16, 18, 4, 68π holdπ putscrn lastscrn$(0)π holdπCOLOR 1, 7π putwin 3, 22, 3, 77, 1, "This is the top text", 7, 1πCOLOR 1, 7π center 3, 77, " This is the bottom text...", 22π holdπCOLOR 15, 1π cover 4, 21, 4, 76, 88 ' put some junk in boxπ holdπCOLOR 7, 4π putwin 6, 18, 7, 60, 1, "", 4, 7π holdπ putscrn lastscrn$(0)π holdπCOLOR 0, 7π putwin 6, 18, 7, 70, 1, "", 7, 0πCOLOR 15, 0π center 7, 70, "That's all.......", 12π holdπCOLOR 7, 0πCLSπENDππ'---------------------------------------------------------------------------πSUB center (lcol%, rcol%, text$, row%)ππcols% = (rcol% - lcol%) + 1 ' # of columns to center text inπcdif% = cols% - LEN(text$) ' difference in text length and col%πmcol% = (cdif% \ 2) + lcol% ' column to start atπLOCATE row%, mcol%πPRINT text$;ππEND SUBπ'---------------------------------------------------------------------------πSUB cover(trow%, brow%, lcol%, rcol%, cnum%)ππnumcols% = (rcol% - lcol%) + 1 ' # of columns to coverππFOR x% = trow% TO brow% ' for loop covers form toprow toπ LOCATE x%, lcol% ' bottomrow, numcol% wide withπ PRINT STRING$(numcols%, cnum%); ' character(chr$) number (cnum%)πNEXT x%ππEND SUBπ'---------------------------------------------------------------------------πSUB lilshad (trow%, brow%, lcol%, rcol%)ππIF trow% = brow% THEN GOTO onelineππnumcol% = (rcol% - lcol%) + 1πLOCATE brow% + 1, lcol% + 1: PRINT STRING$(numcol%, 223);πLOCATE trow%, rcol% + 1: PRINT CHR$(220);ππFOR x% = trow% + 1 TO brow%π LOCATE x%, rcol% + 1π PRINT CHR$(219);πNEXT x%πEXIT SUBππoneline: ' if just 1 rowππnumcol% = (rcol% - lcol%) + 1πLOCATE brow% + 1, lcol% + 1: PRINT STRING$(numcol%, 223);πLOCATE trow%, rcol% + 1: PRINT CHR$(220);ππEND SUBπ'---------------------------------------------------------------------------πSUB putwin(trow%, brow%, lcol%, rcol%, shad%, text$, fg%, bg%)ππ' putwin calls putbox to make initial boxπputbox trow%, brow%, lcol%, rcol%, 6, shad%, text$ ' border here must be 6πcolor fg%, bg% ' must be reverse of original color for putwinπnumcols% = (rcol% - lcol%) + 1 ' # of columns to coverππFOR x% = trow% + 1 TO brow% - 1 ' leave border top and bottomπ LOCATE x%, lcol%π PRINT STRING$(numcols%, 0); ' print nothing to cover (0)πNEXT x%ππFOR x% = trow% + 1 TO brow% - 1π LOCATE x%, lcol%: PRINT CHR$(221) ' left borderπ LOCATE x%, rcol%: PRINT CHR$(222) ' right borderπNEXT x%ππEND SUBπ'---------------------------------------------------------------------------πSUB putbox(trow%, brow%, lcol%, rcol%, bord%, shad%, text$)ππ SELECT CASE bord%π CASE 1 ' single line borderπ tlc$ = CHR$(218): tm$ = CHR$(196): trc$ = CHR$(191): s$ = CHR$(179)π blc$ = CHR$(192): bm$ = CHR$(196): brc$ = CHR$(217)π CASE 2 ' double line borderπ tlc$ = CHR$(201): tm$ = CHR$(205): trc$ = CHR$(187): s$ = CHR$(186)π blc$ = CHR$(200): bm$ = CHR$(205): brc$ = CHR$(188)π CASE 3 ' double line top, single line sideπ tlc$ = CHR$(213): tm$ = CHR$(205): trc$ = CHR$(184): s$ = CHR$(179)π blc$ = CHR$(212): bm$ = CHR$(205): brc$ = CHR$(190)π CASE 4 ' single line top, double line sideπ tlc$ = CHR$(214): tm$ = CHR$(196): trc$ = CHR$(183): s$ = CHR$(186)π blc$ = CHR$(211): bm$ = CHR$(196): brc$ = CHR$(189)π CASE 5 ' thick line all sidesπ tlc$ = CHR$(219): tm$ = CHR$(223): trc$ = CHR$(219): s$ = CHR$(219)π blc$ = CHR$(219): bm$ = CHR$(220): brc$ = CHR$(219)π CASE 6 ' no linesπ tlc$ = CHR$(0): tm$ = CHR$(0): trc$ = CHR$(0): s$ = CHR$(0)π blc$ = CHR$(0): bm$ = CHR$(0): brc$ = CHR$(0)π CASE ELSE ' single line if < 1 or > 6π tlc$ = CHR$(218): tm$ = CHR$(196): trc$ = CHR$(191): s$ = CHR$(179)π blc$ = CHR$(192): bm$ = CHR$(196): brc$ = CHR$(217)πEND SELECTππwide% = (rcol% - lcol%) - 1ππIF text$ > "" THEN ' text$ is title if wantedπ widedif% = wide% - LEN(text$)π rwide% = widedif% - 3 ' put title 3 columns right of top-left cornerπ LOCATE trow%, lcol%π PRINT tlc$; STRING$(3, tm$); text$; STRING$(rwide%, tm$); trc$ ' top with titleπELSEπ LOCATE trow%, lcol%π PRINT tlc$; STRING$(wide%, tm$); trc$; ' top with no titleπEND IFππFOR I% = trow% + 1 TO brow% - 1 ' for loop prints middleπ LOCATE I%, lcol%π PRINT s$; SPACE$(wide%); s$;πNEXT I%ππLOCATE brow%, lcol%πPRINT blc$; STRING$(wide%, bm$); brc$; ' print bottomππIF shad% = 0 THEN EXIT SUB ' if no shadow wanted (0) exit subππ' put shadow right side and bottom of boxππvideo& = vidseg& ' call vidseg& functionπIF video& = &hb000 THENπ EXIT SUB ' monochrome, no need for shadowπELSEπ DEF SEG = &hb800πEND IFππ' get present screen attributesπattr% = SCREEN(brow% + 1, rcol% + 1, -1) ' get attributeπattr% = attr% AND 15 ' get forgroundπattr% = attr% - 8 ' dim if brightπIF attr% < 1 THEN attr% = 8 ' if wasn't brightπ' if don't want dim, 15 to 7 or 9 to 1, use 8 for attr%ππ' POKE shadow where needed...POKE right sideππFOR row% = trow% + 1 TO brow% + 1 ' 1 less than top, 1 greater than bottomπ FOR col% = rcol% + 1 TO rcol% + shad% ' shad% is # columns, 1 or 2 usuallyπ offset% = (row% - 1) * 160 + (col% - 1) * 2 + 1π POKE offset%, attr%π NEXTπNEXTπ' POKE bottomπrow% = brow% + 1 '1 row past bottomππFOR col% = lcol% + shad% TO rcol% + shad% ' shad% is 1 or 2π offset% = (row% - 1) * 160 + (col% - 1) * 2 + 1π POKE offset%, attr%πNEXTππDEF SEGππEND SUBπ'---------------------------------------------------------------------------πSUB putscrn(scrn$)ππdef seg = vidseg&πpoke$ 0, scrn$πdef segππEND SUBπ'---------------------------------------------------------------------------πFUNCTION getscrn$()ππdef seg = vidseg&πgetscrn$ = peek$(0, 4000) ' 1 screen colorπdef segππEND FUNCTIONππ'---------------------------------------------------------------------------πFUNCTION vidseg&()ππDEF SEG = 0πIF PEEK(&h463) = &hb4 THENπ vidseg& = &hb000πELSEπ vidseg& = &hb800πEND IFπDEF SEGππEND FUNCTIONπ'---------------------------------------------------------------------------πSUB hold()ππWHILE NOT INSTATπLOOPπDOπLOOP UNTIL INKEY$ = ""ππEND SUBπDarryl Schneider INTERNET SEARCH UTILITY fish2@datanet.ab.ca 07-15-96 (22:07) QB, QBasic, PDS 456 15236 QSEARCH.BAS 'This is a little internet search utility thatπ'searches all of the web sites or newsgroups inπ'its database, depending on the keyword you typeπ'in. Modify it by adding your own sites to theπ'database. It might be kind of hard to read,π'despite the fact I added in a few comments.π'Oh well, as long as it works! Enjoy :)π'π'Written by Darryl Schneiderπ'E-mail: fish2@datanet.ab.caπ'The QBasic Zoneπ'http://www.geocities.com/SiliconValley/8191/π'πSCREEN 12ππDIM BCURSOR(1 TO 500) 'draw the little arrow cursorπLINE (50, 50)-(50, 60), 1 'Throughout the program I doπLINE (50, 50)-(70, 55), 1 'not use PSET to move the cursor.πLINE (50, 60)-(70, 55), 1 'Instead I just cover up my tracksπPAINT (55, 55), 3, 1 'with LINE (), , B and move ahead!πGET (50, 50)-(70, 60), BCURSOR 'Save the cursorππDEFSTR A, C-W 'define some variablesπDEFINT X-YπDEFLNG ZπCASES = "N" 'right now it is not case-sensitiveπSEARCHLIMITS = "NONE" 'there are no search limits setππMAINMENU: 'start of the main menuπCLSπZTOTAL1 = 0 'resets some variables to zeroπZTOTAL2 = 0πZTOTAL3 = 0πZHTML = 0πZFTP = 0πZNEW = 0πZHTMLT = 2 'these next three are the numberπZFTPT = 2 'of sites in each database. WhenπZNEWT = 2 'you add a new site, make sure youπ 'increase the number correspondingπ 'to the database or else it won'tπ 'work properly!πENTER = CHR$(13)πUP = CHR$(0) + CHR$(72)πDOWN = CHR$(0) + CHR$(80)ππLINE (140, 46)-(500, 360), 9, BF 'draw the main menu screenπLINE (140, 46)-(500, 65), 11, BFπCOLOR 10: LOCATE 4, 35: PRINT "QuickSearch"πCOLOR 15: LOCATE 7, 25: PRINT "Enter keyword: "πCOLOR 12: LOCATE 10, 34: PRINT "Search Options"πCOLOR 15: LOCATE 13, 25: PRINT "Case-Sensitive: "; : COLOR 14: PRINT CASESπCOLOR 15: LOCATE 15, 25: PRINT "Search Limits: "; : COLOR 14: PRINT SEARCHLIMITS; " "πCOLOR 10: LOCATE 17, 25: PRINT "Search"πCOLOR 15: LOCATE 20, 25: PRINT "About QuickSearch"πCOLOR 15: LOCATE 22, 25: PRINT "End Search"ππMM1: 'all of the MM labels areπC1 = "" 'the different cursor locationsπPUT (168, 96), BCURSORπDOπC1 = INKEY$πIF C1 = ENTER THENπ LOCATE 7, 40: INPUT "", KEYWORD 'input the keywordπ GOSUB MM1 'If you type "basic"πEND IF 'you get 5 of the 6πIF C1 = UP THEN 'sites displayedπ LINE (168, 96)-(188, 106), 9, BFπ GOSUB MM6πEND IFπIF C1 = DOWN THENπ LINE (168, 96)-(188, 106), 9, BFπ GOSUB MM2πEND IFπLOOPππMM2:πC2 = ""πPUT (168, 192), BCURSORπDOπC2 = INKEY$πIF C2 = ENTER THENπ SELECT CASE CASESπ CASE "N" 'change to case-sensitiveπ CASES = "Y"π LOCATE 13, 41: COLOR 14: PRINT CASESπ COLOR 15π GOSUB MM2π CASE "Y" 'change to case-insensitiveπ CASES = "N"π LOCATE 13, 41: COLOR 14: PRINT CASESπ COLOR 15π GOSUB MM2π END SELECTπEND IFπIF C2 = UP THENπ LINE (168, 192)-(188, 202), 9, BFπ GOSUB MM1πEND IFπIF C2 = DOWN THENπ LINE (168, 192)-(188, 202), 9, BFπ GOSUB MM3πEND IFπLOOPππMM3: 'this label grouping changes theπC3 = "" 'search limitsπPUT (168, 226), BCURSORπDOπC3 = INKEY$πIF C3 = ENTER THENπ IF SEARCHLIMITS = "NONE" THENπ SEARCHLIMITS = "HTML"π LOCATE 15, 40: COLOR 14: PRINT SEARCHLIMITSπ COLOR 15π GOSUB MM3π END IFπ IF SEARCHLIMITS = "HTML" THENπ SEARCHLIMITS = "FTP"π LOCATE 15, 40: COLOR 14: PRINT SEARCHLIMITS; " "π COLOR 15π GOSUB MM3π END IFπ IF SEARCHLIMITS = "FTP" THENπ SEARCHLIMITS = "NEWS"π LOCATE 15, 40: COLOR 14: PRINT SEARCHLIMITSπ COLOR 15π GOSUB MM3π END IFπ IF SEARCHLIMITS = "NEWS" THENπ SEARCHLIMITS = "NONE"π LOCATE 15, 40: COLOR 14: PRINT SEARCHLIMITSπ COLOR 15π GOSUB MM3π END IFπEND IFπIF C3 = UP THENπ LINE (168, 226)-(188, 236), 9, BFπ GOSUB MM2πEND IFπIF C3 = DOWN THENπ LINE (168, 226)-(188, 236), 9, BFπ GOSUB MM4πEND IFπLOOPππMM4:πC4 = ""πPUT (168, 258), BCURSORπDOπC4 = INKEY$πIF C4 = ENTER THENπ GOSUB STARTSEARCH 'begin the search!πEND IFπIF C4 = UP THENπ LINE (168, 258)-(188, 268), 9, BFπ GOSUB MM3πEND IFπIF C4 = DOWN THENπ LINE (168, 258)-(188, 268), 9, BFπ GOSUB MM5πEND IFπLOOPππMM5:πC5 = ""πPUT (168, 306), BCURSORπDOπC5 = INKEY$πIF C5 = ENTER THENπ GOSUB ABOUT 'go to the about screenπEND IFπIF C5 = UP THENπ LINE (168, 306)-(188, 316), 9, BFπ GOSUB MM4πEND IFπIF C5 = DOWN THENπ LINE (168, 306)-(188, 316), 9, BFπ GOSUB MM6πEND IFπLOOPπMM6:πC6 = ""πPUT (168, 338), BCURSORπDOπC6 = INKEY$πIF C6 = ENTER THENπ GOSUB QUIT 'quitπEND IFπIF C6 = UP THENπ LINE (168, 338)-(188, 348), 9, BFπ GOSUB MM5πEND IFπIF C6 = DOWN THENπ LINE (168, 338)-(188, 348), 9, BFπ GOSUB MM1πEND IFπLOOPππSTARTSEARCH:πCLSπIF KEYWORD = "" THEN GOSUB MAINMENUπIF CASES = "N" THEN KEYWORD = UCASE$(KEYWORD)πPRINT " QuickSearch Results for query: "; : COLOR 14: PRINT KEYWORDπCOLOR 15πPRINT ""πIF SEARCHLIMITS = "NONE" THEN GOSUB SEARCH1 'a little filter dependingπIF SEARCHLIMITS = "HTML" THEN GOSUB SEARCH1 'on the search limitsπIF SEARCHLIMITS = "FTP" THEN GOSUB SEARCH2πIF SEARCHLIMITS = "NEWS" THEN GOSUB SEARCH3ππSEARCH1:πRESTORE HTMLSITES 'finds all the HTML sitesπNEXTHTML:πIF ZHTML = ZHTMLT THENπ Y1 = 1π IF SEARCHLIMITS = "NONE" THENπ IF ZTOTAL1 = 1 THEN ZTOTAL2 = 1π IF ZTOTAL1 = 2 THEN ZTOTAL2 = 2π IF ZTOTAL1 = 3 THEN ZTOTAL2 = 3π IF ZTOTAL1 = 4 THEN ZTOTAL2 = 4π GOSUB SEARCH2π END IFπ IF SEARCHLIMITS = "HTML" THEN GOSUB NOMOREπEND IFπPREV1:πREAD HTMLSITE, HTMLADDRESS, HTMLDESCRIPTION, HTMLDESCRIPTION2πIF CASES = "N" THEN GOSUB HTMLUPπIF CASES = "Y" THEN GOSUB HTMLLOWπHTMLUP:π IF INSTR(UCASE$(HTMLSITE), UCASE$(KEYWORD)) > 0 THENπ COLOR 13: PRINT HTMLSITEπ COLOR 11: PRINT " "; HTMLDESCRIPTIONπ PRINT " "; HTMLDESCRIPTION2π COLOR 12: PRINT " http://"; HTMLADDRESSπ COLOR 15:π PRINT ""π ZTOTAL1 = ZTOTAL1 + 1π ZHTML = ZHTML + 1π IF ZHTML = ZHTMLT THEN GOSUB NEXTHTMLπ IF ZTOTAL1 = 4 THEN GOSUB NEXTPAGEπ GOSUB NEXTHTMLπ ELSEπ ZHTML = ZHTML + 1π GOSUB NEXTHTMLπ END IFπHTMLLOW: π IF INSTR(HTMLSITE, KEYWORD) > 0 THENπ COLOR 13: PRINT HTMLSITEπ COLOR 11: PRINT " "; HTMLDESCRIPTIONπ PRINT " "; HTMLDESCRIPTION2π COLOR 12: PRINT " http://"; HTMLADDRESSπ COLOR 15:π PRINT ""π ZTOTAL1 = ZTOTAL1 + 1π ZHTML = ZHTML + 1π IF ZHTML = ZHTMLT THEN GOSUB NEXTHTMLπ IF ZTOTAL1 = 4 THEN GOSUB NEXTPAGEπ GOSUB NEXTHTMLπ ELSEπ ZHTML = ZHTML + 1π GOSUB NEXTHTMLπ END IFππSEARCH2:πRESTORE FTPSITES 'finds the FTP sitesπNEXTFTP:πIF ZFTP = ZFTPT THENπ Y2 = 1π IF SEARCHLIMITS = "NONE" THENπ IF ZTOTAL2 = 1 THEN ZTOTAL3 = 1π IF ZTOTAL2 = 2 THEN ZTOTAL3 = 2π IF ZTOTAL2 = 3 THEN ZTOTAL3 = 3π IF ZTOTAL2 = 4 THEN ZTOTAL3 = 4π GOSUB SEARCH3π END IFπ IF SEARCHLIMITS = "FTP" THEN GOSUB NOMOREπEND IFπIF ZTOTAL2 = 4 THEN GOSUB NEXTPAGEπPREV2:πREAD FTPSITE, FTPADDRESS, FTPDESCRIPTION, FTPDESCRIPTION2πIF CASES = "N" THEN GOSUB FTPUPπIF CASES = "Y" THEN GOSUB FTPLOWπFTPUP:π IF INSTR(UCASE$(FTPSITE), UCASE$(KEYWORD)) > 0 THENπ COLOR 13: PRINT FTPSITEπ COLOR 11: PRINT " "; FTPDESCRIPTIONπ PRINT " "; FTPDESCRIPTION2π COLOR 12: PRINT " ftp://"; FTPADDRESSπ COLOR 15:π PRINT ""π ZTOTAL2 = ZTOTAL2 + 1π ZFTP = ZFTP + 1π IF ZFTP = ZFTPT THEN GOSUB NEXTFTPπ IF ZTOTAL2 = 4 THEN GOSUB NEXTPAGEπ GOSUB NEXTFTPπ ELSEπ ZFTP = ZFTP + 1π GOSUB NEXTFTPπ END IFπFTPLOW:π IF INSTR(FTPSITE, KEYWORD) > 0 THENπ COLOR 13: PRINT FTPSITEπ COLOR 11: PRINT " "; FTPDESCRIPTIONπ PRINT " "; FTPDESCRIPTION2π COLOR 12: PRINT " ftp://"; FTPADDRESSπ COLOR 15:π PRINT ""π ZTOTAL2 = ZTOTAL2 + 1π ZFTP = ZFTP + 1π IF ZFTP = ZFTPT THEN GOSUB NEXTFTPπ IF ZTOTAL2 = 4 THEN GOSUB NEXTPAGEπ GOSUB NEXTFTPπ ELSEπ ZFTP = ZFTP + 1π GOSUB NEXTFTPπ END IFππSEARCH3:πRESTORE NEWSITES 'finds some newsgroupsπNEXTNEW:πIF ZNEW = ZNEWT THENπ IF SEARCHLIMITS = "NONE" THEN GOSUB NOMOREπ IF SEARCHLIMITS = "NEWS" THEN GOSUB NOMOREπEND IFπIF ZTOTAL3 = 4 THEN GOSUB NEXTPAGEπPREV3:πREAD NEWSITE, NEWDESCRIPTION, NEWDESCRIPTION2πIF CASES = "N" THEN GOSUB NEWUPπIF CASES = "Y" THEN GOSUB NEWLOWπNEWUP:π IF INSTR(UCASE$(NEWSITE), UCASE$(KEYWORD)) > 0 THENπ COLOR 13: PRINT NEWSITEπ COLOR 11: PRINT " "; NEWDESCRIPTIONπ PRINT " "; NEWDESCRIPTION2π COLOR 15:π PRINT ""π ZTOTAL3 = ZTOTAL3 + 1π ZNEW = ZNEW + 1π IF ZNEW = ZNEWT THEN GOSUB NEXTNEWπ IF ZTOTAL3 = 4 THEN GOSUB NEXTPAGEπ GOSUB NEXTNEWπ ELSEπ ZNEW = ZNEW + 1π GOSUB NEXTNEWπ END IFπNEWLOW:π IF INSTR(NEWSITE, KEYWORD) > 0 THENπ COLOR 13: PRINT NEWSITEπ COLOR 11: PRINT " "; NEWDESCRIPTIONπ PRINT " "; NEWDESCRIPTION2π COLOR 15:π PRINT ""π ZTOTAL3 = ZTOTAL3 + 1π ZNEW = ZNEW + 1π IF ZNEW = ZNEWT THEN GOSUB NEXTNEWπ IF ZTOTAL3 = 4 THEN GOSUB NEXTPAGEπ GOSUB NEXTNEWπ ELSEπ ZNEW = ZNEW + 1π GOSUB NEXTNEWπ END IFππNOMORE: 'no more matches to the keywordπLOCATE 25, 5: PRINT "No more matches...press enter to return to the main menu..."πDOπD2 = UCASE$(INKEY$)πIF D2 = ENTER THEN GOSUB MAINMENUπLOOPππ'databasesππHTMLSITES:πDATA The QBasic Zone, www.geocities.com/SiliconValley/8191/, - Includes programs; tutorials; compilers; a huge, list of links and much more!πDATA The All Basic Code Home Page, charlie.simplenet.com/abc/abchome.html, - Has ABC packets filled with tons of, source code for you to use.ππFTPSITES:πDATA M / K Productions, members.aol.com/blood225/, - Lots of files to download,πDATA SimTel MSDOS Basic, oak.oakland.edu/SimTel/msdos/basic/, An archive of files to download,ππNEWSITES:πDATA comp.lang.basic.misc, - Discussion of any BASIC programming language,πDATA alt.lang.basic, - Discussion of all the BASIC programming languages,ππ'end of databasesππABOUT: 'the infamous about screenπCLSπPRINT " About QuickSearch"πPRINT ""πPRINT "QuickSearch was written in Microsoft QuickBasic by 14-year old Darryl"πPRINT "Schneider. It is designed to be an off-line search utility so you"πPRINT "do not have to go back and forth while 'web surfing' to search for"πPRINT "the address of a web site. Above this in the source code are the"πPRINT "DATA statements for HTML and FTP sites, as well as Newsgroups. You"πPRINT "may add your own sites to the list, and build up a large database."πPRINT "With the HTML and FTP databases, the first series of words is the title"πPRINT "of the site, the next series is the address, next the first line of the"πPRINT "description, and then the second line of description. It is the same for"πPRINT "newsgroups except there is no address. At the main menu you can have"πPRINT "a case-sensitive or non-sensitive search, and can search with no"πPRINT "limits (None), only in HTMLs (HTML), only in FTPs (FTP), or only in"πPRINT "newsgroups (NEWS), by cycling through pressing enter. I hope that this"πPRINT "application proves useful in some way and helps you with programming"πPRINT "or your web surfing!"πPRINT ""πPRINT "Press enter to return to the main menu..."πDOπD3 = UCASE$(INKEY$)πIF D3 = ENTER THEN GOSUB MAINMENUπLOOPππQUIT:πENDππNEXTPAGE:πLOCATE 25, 5: PRINT "Press enter for more or 'Q' to quit..."πDOπD1 = UCASE$(INKEY$) 'goes to the next page after 4πIF D1 = ENTER THEN 'sites have been displayedπ IF Y1 = 1 THEN GOSUB NEXT2π IF ZTOTAL1 = 4 THENπ IF ZHTML = ZHTMLT THEN GOSUB NEXTHTMLπ ZTOTAL1 = 0π CLSπ PRINT " QuickSearch Results for query: "; : COLOR 14: PRINT KEYWORDπ PRINT ""π COLOR 15π GOSUB PREV1π END IFπNEXT2: π IF Y2 = 1 THEN GOSUB NEXT3π IF ZTOTAL2 = 4 THENπ IF ZFTP = ZFTPT THEN GOSUB NEXTFTPπ ZTOTAL2 = 0π CLSπ PRINT " QuickSearch Results for query: "; : COLOR 14: PRINT KEYWORDπ PRINT ""π COLOR 15π GOSUB PREV2π END IFπNEXT3:π IF ZTOTAL3 = 4 THENπ IF ZNEW = ZNEWT THEN GOSUB NEXTNEWπ ZTOTAL3 = 0π CLSπ PRINT " QuickSearch Results for query: "; : COLOR 14: PRINT KEYWORDπ PRINT ""π COLOR 15π GOSUB PREV3π END IFπEND IFπIF D1 = "Q" THEN GOSUB MAINMENUπLOOPππ'end of QuickSearchπChristoph Kummetat PROGRAM THE PARALLEL PORT FidoNet QUIK_BAS Echo 07-13-96 (13:44) QB, QBasic, PDS 125 5033 PARALLEL.BAS'> With 8 data lines I have many options and combinations thereof. I amπ'> not familair with the bit structure of characters. Any clue as to howπ'> to go about deciding the characters to use that would activate lineπ'> "1" only while leaving the others alone?ππ'here's some code, which might help you to program the parallel port. π'Originally it is a programm to set 8 relais via LPT. I shortened it to the π'important things. If you have more questions about, feel free to ask me...ππInitVar:π DEFINT A-Zπ DIM SHARED Bit(8), BitStatus, Port, RelNrπ DIM SHARED Anzahl(8)ππ CONST Blk = 0, Blu = 1, Grn = 2, Zyn = 3, Red = 4 'set colorsπ CONST Gry = 7, Yel = 14, Wht = 15, Blink = 16π CONST TRUE = 1, FALSE = NOT TRUE 'set booleanππ CLS : Count = 1π FOR i = 1 TO 8π Bit(i) = Count 'set bits with bit-valuesπ Count = Count + Count 'increase values (0,1,2,4,8,16,32,64,128)π NEXT iππ CALL DATEN.Find.LPT 'search for LPTsππ BitStatus = 0 'switch all lines OFFπ OUT Port, BitStatus 'send to LPTπ CALL DATEN.Get.Status 'read LPTπππWHILE INKEY$ <> "q"π CALL DATEN.Set.Statusπ FOR i = 1 TO 8π CALL DATEN.Get.Statusπ NEXT iπWENDππ OUT Port, LEDStatus 'an par. SN sendenππSUB DATEN.Find.LPTπ DEF SEG = 0: DIM Port(4)π Count = 0: COLOR Wht, Bluπ FOR i = 1032 TO 1036 STEP 2π IF PEEK(i) + 256 * PEEK(i + 1) > 0 THENπ Count = Count + 1π Port(Count) = VAL("&H" + HEX$(PEEK(i) + 256 * PEEK(i + 1)))π LOCATE 4 + Count, 6π PRINT "Printerport"; STR$(Count); " : ";π PRINT "&H" + HEX$(PEEK(i) + 256 * PEEK(i + 1))π END IFπ NEXT iπ IF Count = 0 THEN 'no port foundπ PRINT "No parallel port found on your PC !";π ch$ = INPUT$(1)π CLOSE : COLOR Wht, Blk: CLS : ENDπ END IFππGetPrt: 'choose LPTπ LOCATE , 6: PRINT "Which parallel port do you want to use : ";π v$ = INPUT$(1) 'ask for LPTπ IF VAL(v$) < 1 OR VAL(v$) > Count THENπ SOUND 3200, .3: GOTO GetPrt 'invalid valueπ END IFπ Port = Port(VAL(v$)) 'define portπEND SUBππSUB DATEN.Get.Statusπ BitStatus = INP(Port) 'read LPTπ FOR i = 1 TO 8π IF BitStatus AND Bit(i) THENπ Status = 1π ELSEπ Status = 0π END IFπ CALL DISPLAY.Status(i, Status)π NEXT iπEND SUBππSUB DATEN.Relais.Resetπ BitStatus = 0: OUT Port, BitStatus 'reset all registers at LPTπEND SUBππSUB DATEN.Set.Status 'send value to LPTπ COLOR Blk, Gry:π LOCATE 12, 6: PRINT "which line to set ? : "π LOCATE 13, 6: PRINT "(number 1 - 8 or 0 for all OUT) "ππGetBit:π v$ = INPUT$(1) 'number of LPTπ BitNr = VAL(v$)π IF ASC(v$) = 27 THEN COLOR Wht, Blk: CLS : END 'Escape, end programπ IF BitNr > 8 THEN SOUND 3200, .3: GOTO GetBit 'hey, you can only choose between 1 and 8πGetSts:π IF BitNr = 0 THENπ BitStatus = 0 'switch all lines OFFπ OUT Port, BitStatus 'send to LPTπ CALL DISPLAY.Status(BitNr, BitStatus) 'display statusπ ELSEIF BitStatus AND Bit(BitNr) THEN 'is line ON or OFF ?π BitStatus = BitStatus XOR Bit(BitNr) 'swith bit/line to OFFπ OUT Port, BitStatus 'send to LPTπ CALL DISPLAY.Status(BitNr, BitStatus) 'display statusπ ELSEπ BitStatus = BitStatus + Bit(BitNr) 'add bit/lineπ OUT Port, BitStatus 'send to LPTπ CALL DISPLAY.Status(BitNr, BitStatus) 'display statusπ END IFπEND SUBππSUB DISPLAY.Status (BitNr, Status) 'show status of bits/linesπ IF BitNr >= 1 THENπ IF Status >= 1 THENπ COLOR Wht, Red 'bit/line activeπ LOCATE 8, ((BitNr * 8) + BitNr) - 3: PRINT " ON "π ELSEπ COLOR Wht, Grn 'bit/line inactiveπ LOCATE 8, ((BitNr * 8) + BitNr) - 3: PRINT " OFF "π END IFπ ELSEπ COLOR Wht, Grn 'all bits/lines OFFπ FOR i = 1 TO 8π LOCATE 8, ((i * 8) + i) - 3: PRINT " OFF "π NEXT iπ END IFπEND SUBπRobert Fortune BBS GAME PROGRAMMING FidoNet QUIK_BAS Echo 04-14-96 (00:00) QB, QBasic, PDS 245 8996 GAMESHEL.BAS'>statements, but the Real problem is, what if a new userπ'>wants to use the game? Can someone help... I need it toπ'>open the player.dat file, search for the Real Name, Loadπ'>The Data, And Save The Data in the right spot.... Canπ'>Someone Help Me?ππ' I can try. The following code uses a random access file to keepπ' scores for a BBS game. The PlayerName field is the key fieldπ' that the code uses to keep track of the players and their scores,π' etc... The code also creates an SCORES.ANS file which is just an ANSIπ' high scores file that a SysOp can use on his BBS bulletin(s) menu. Youπ' can modify as needed or use as a rough guide. It will reach you inπ' 2 messages as it's kind of long so you will need to edit it back intoπ' a single file before running it. Hope it helps. Good luck!ππ' ----------------------- CUT HERE -------------CUT HERE ----------------πREM GAMESHEL.BAS 04/14/96πREM QB/QBX Demo game shell using a Random Access data file to store,πREM sort and display players names and scores. Also creates an ANSIπREM color high scores bulletin file (SCORES.ANS)ππDEFINT A-Z ' all untyped variables default to type integerπDECLARE SUB MoveCursor (X%, Y%) ' position cursor on screenπDECLARE SUB SetColors (FG%, BG%, Attrib%) ' set ANSI colors to useππREM Define our random access file structureπTYPE GameRecordπ RecordNumber AS INTEGERπ PlayerAlias AS STRING * 25π PlayerName AS STRING * 25π ExperPoints AS LONGπ GoldOnHand AS LONGπ GoldInBank AS LONGπ Beauty AS LONGπ GEMS AS LONGπ PlayerScore AS LONGπ PlayerDay AS STRING * 11πEND TYPEπDIM PlayerRecord AS GameRecord ' reserve some memoryπDIM TempRecord AS GameRecordππCONST True = -1, False = NOT TrueπClrScrn$ = CHR$(27) + "[2J" ' clear ANSI screenππOPEN "CONS:" FOR OUTPUT AS #1 ' local output via CONSole deviceππREM Open the random access players fileπOPEN "GAMEFILE.DAT" FOR RANDOM AS #2 LEN = LEN(PlayerRecord)ππREM Here is where you would normally get the player's name from the BBS dropπREM file (DOOR.SYS, PCBOARD.SYS, etc...). As an example we get the player'sπREM name manually. In a BBS game door you should get the info from the BBSπREM drop file.ππDOπ CLSπ LINE INPUT "Please enter your FULL Name: "; FullName$π FullName$ = UCASE$(FullName$)πLOOP WHILE FullName$ = ""ππREM Search existing records for a match on player's full name.πREM We're using record number 1 for the All-Time-Winner recordπREM to keep all the player data in the same file.ππRecordNumber% = 1 ' this record is reserved for All-Time-WinnerπIF LOF(2) > 0 THEN ' Any records in the file yet?π DOπ RecordNumber% = RecordNumber% + 1π GET #2, RecordNumber%, PlayerRecordπ LOOP UNTIL (RTRIM$(PlayerRecord.PlayerName) = FullName$) OR (EOF(2))πELSEπ RecordNumber% = RecordNumber% + 1π PlayerRecord.PlayerName = FullName$π PlayerRecord.PlayerScore = 500 ' start each player with 500 pointsπ PlayerRecord.PlayerDay = DATE$π PUT #2, 1, PlayerRecordπ PUT #2, 2, PlayerRecordπEND IFππREM Did we find a match?ππIF RTRIM$(PlayerRecord.PlayerName) <> FullName$ THEN ' No match, new playerπ RecordNumber% = LOF(2) \ LEN(PlayerRecord) + 1π PlayerRecord.PlayerName = FullName$π PlayerRecord.PlayerScore = 500 ' start each player with 500 pointsπ PlayerRecord.PlayerDay = DATE$π PUT #2, RecordNumber%, PlayerRecordπEND IFπCLOSE #2ππScore# = PlayerRecord.PlayerScoreππStart:ππ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *π' YOUR PROGRAM STARTS HEREπ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *ππ' Somewhere in your game player would win/lose points as inππScore# = Score# + 10 ' demo score keeper for gameππ' More of your game programππ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *π' YOUR GAME ENDS HERE. Now we need to update the player's scores.π' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *ππFinish:ππOPEN "GAMEFILE.DAT" FOR RANDOM AS #2 LEN = LEN(PlayerRecord)πOPEN "SCORES.ANS" FOR OUTPUT AS #3 ' open ANSI high scores bulletin fileππRecordNumber% = 2πGET #2, RecordNumber%, PlayerRecordπDO UNTIL RTRIM$(PlayerRecord.PlayerName) = FullName$π RecordNumber% = RecordNumber% + 1π GET #2, RecordNumber%, PlayerRecordπLOOPπPlayerRecord.PlayerScore = Score#πPlayerRecord.PlayerDay = DATE$ππREM See if we have a new All-Time-WinnerπGET #2, 1, TempRecordπIF PlayerRecord.PlayerScore > TempRecord.PlayerScore THENπ PUT #2, 1, PlayerRecord ' write a new all-time winner recordπEND IFππREM Write the updated player's record to random access highscores fileπPUT #2, RecordNumber%, PlayerRecordπ' (Disk) Sort players scores using basic bubblesort from MS QB Bible bookπDOπ Switch = Falseπ FOR I% = 2 TO (LOF(2) \ LEN(PlayerRecrd)) - 1π GET #2, I%, PlayerRecordπ GET #2, I% + 1, TempRecordπ IF PlayerRecord.PlayerScore < TempRecord.PlayerScore THENπ SWAP PlayerRecord, TempRecordπ PUT #2, I%, PlayerRecordπ PUT #2, I% + 1, TempRecordπ Switch = Trueπ END IFπ NEXT IπLOOP WHILE Switchπ' Now print the players names and scores which are in sorted orderπ' in the GAMEFILE.DAT file (sorted on players' scores).ππPRINT #1, ClrScrn$ ' clear the screenπPRINT #3, ClrScrn$ππREM this is where the final score board starts .πGET #2, 1, PlayerRecordπCALL SetColors(33, 40, 1) ' make screen colors bright yellow on blackππREM (Long line split to fit email line length)πText$ = "< < < " + RTRIM$(PlayerRecord.PlayerName) + " won "πText$ = Text$ + LTRIM$(STR$(PlayerRecord.PlayerScore)) + " points on "πText$ = Text$ + PlayerRecord.PlayerDay + " > > > "ππX% = 2 ' print on 2nd line of screenπY% = 40 - LEN(Text$) \ 2 ' center the high scores titleπCALL MoveCursor(X%, Y%) ' position the cursorπPRINT #1, Text$ ' print high scores title to the screenπPRINT #3, Text$ ' print high scores title to the SCORES.ANS fileπCALL SetColors(34, 40, 1) ' make screen colors bright blue on blackπText$ = "Last Played Player Score"πX% = 4πY% = 40 - LEN(Text$) \ 2πCALL MoveCursor(X%, Y%)πPRINT #1, Text$πPRINT #3, Text$πCALL SetColors(31, 40, 1) ' make screen colors bright red on blackπText$ = "-------------------------------------------------"πX% = X% + 1πY% = 40 - LEN(Text$) \ 2πCALL MoveCursor(X%, Y%)πPRINT #1, Text$πPRINT #3, Text$πCALL SetColors(32, 40, 1) ' make screen colors bright green on blackπY% = Y% + 2πREM Print out the first 10 records in our random access fileπIF LOF(2) \ LEN(PlayerRecord) < 12 THENπ Bottom% = LOF(2) \ LEN(PlayerRecord)πELSEπ Bottom% = 11πEND IFπFOR I% = 2 TO Bottom%π GET #2, I%, PlayerRecordπ Text$ = PlayerRecord.PlayerDay + " " + PlayerRecord.PlayerNameπ Text$ = Text$ + " " + STR$(PlayerRecord.PlayerScore)π X% = X% + 1π CALL MoveCursor(X%, Y%)π PRINT #1, Text$π PRINT #3, Text$πNEXT I%πREM Print an underline after top scores are displayedπCALL SetColors(31, 40, 1) ' make screen colors bright red on blackπText$ = "================================================="πX% = X% + 1πY% = 40 - LEN(Text$) \ 2πCALL MoveCursor(X%, Y%)πPRINT #1, Text$πPRINT #3, Text$πCALL SetColors(40, 37, 1) ' set screen colors bright white on blackπText$ = "[PRESS ANY KEY TO CONTINUE]"πX% = X% + 2πY% = 40 - LEN(Text$) \ 2πCALL MoveCursor(X%, Y%)πPRINT #1, Text$πDOπ AnyKey$ = INKEY$πLOOP UNTIL LEN(AnyKey$)πCALL SetColors(37, 40, 0) ' reset screen colors to drab white on blackπPRINT #1, ClrScrn$ ' clear the screenπCLOSE #1, #2, #3 ' All done. Close up all open filesπEND ' The Endππ' Position cursor on ANSI screen where X% = screen row position andπ' Y% = screen column position where X% can equal 1 thru 25 and Y%π' can equal 1 thru 80.πSUB MoveCursor (X%, Y%)πMove$ = CHR$(27) + "[" + LTRIM$(STR$(X%)) + ";"πMove$ = Move$ + LTRIM$(STR$(Y%)) + "H"πPRINT #1, Move$;πEND SUBππ' Set ANSI screen colorsπ' FG% = ANSI foreground color, BG% = ANSI background color.π' Valid fore colors (FG%) Valid back colors (BG%)π' Black 30 40π' Red 31 41π' Green 32 42π' Yellow 33 43π' Blue 34 44π' Magenta 35 45π' Cyan 36 46π' White 37 47π' ANSI Attr% = attribute (bright(1), blink(5), reverse(7), reset(0)-π' cancelled(8), underline(4) (mono only else blue)πSUB SetColors (FG%, BG%, Attr%)π Text$ = CHR$(27) + "[" + LTRIM$(STR$(Attr%)) + ";"π Text$ = Text$ + LTRIM$(STR$(BG%)) + ";" + LTRIM$(STR$(FG%)) + "m"π PRINT #1, Text$;π PRINT #3, Text$;πEND SUBπRick Pedley SET NEW PRINTER TIMEOUT VALUE QBTIPS_R.DOC 10-09-93 (14:35) QB, PDS 40 1403 TIMEOUT.BAS 'TIMEOUT.BAS π'Sets printer `timeout retry' value to help prevent `printer busy' π'errors. Most machines copy the value 20 (&h14) from the BIOS into π'three RAM addresses, corresponding to printer ports LPT1, 2, and 3. π'Before DOS gives a printer busy error, it cycles 20 x ~260,000 π'times to see if the error has cleared. On a fast computer, say a π'50 MHz 486, this _may_ not be long enough and even copying a file π'to the printer from DOS may cause a R)etry, A)bort, F)ail to be π'displayed. This utility can be run from the DOS prompt or in your π'AUTOEXEC.BAT. If no parameter is specified, it prints the current π'values for each port and a short message. If you regularly get π'printer busy errors even in DOS, run this utility trying different π'values, starting with something greater than 20, until the errors π'disappear. π' π'R. Pedley, 93-10-09 π πDEFINT A-Z πDEF SEG = 64 '0040 πIF LEN(COMMAND$) THEN π T = VAL(COMMAND$) π IF T > 0 AND T < 256 THEN π POKE 120, T ' :0078 π POKE 121, T ' :0079 π POKE 122, T ' :007A π ELSE π BEEP π END IF πEND IF πPRINT πPRINT "Current printer timeout values are:" πPRINT πPRINT "LPT1:"; PEEK(120) πPRINT "LPT2:"; PEEK(121) πPRINT "LPT3:"; PEEK(122) πPRINT πPRINT "To set a new value, use a parameter between 1 and 255," πPRINT "e.g. TIMEOUT 45" πPRINT πDEF SEG πRobert Fortune ACCESSING COM PORT VIA INT 14 FidoNet QUIK_BAS Echo 08-26-96 (11:39) QB, PDS 239 10367 BIOSCOM.BAS '-> Sorry, but that's the way QuickBasic does it. You have to useπ'-> OPEN/CLOSE to read/write to files as well as COMPORTS.ππ'> Actually, I found this in a help file:ππ'>INARY%(AX) = &H3C00 ' DOS function to create a file.π'>INARY% ' DOS attribute for created file.ππ'> It appears that you can use Interrupts to work with files (andπ'>probably devices such as commports). I bet someone here could use the aboveπ'>(or they might not even need it) to create their own OPEN/CLOSE SUBs andπ'>other SUBs to work with the files such as writing to, reading from, andπ'>getting information like LOF and EOF.ππ' Yes you can. Here is some play code I've fiddled around with. It isn'tπ' error-proof but it does demonstrate using BIOS Int 14h to access a comπ' port. You would use similar code to access a FOSSIL driver (BNU, X00...)π' The demo code doesn't do anything but reset\init modem, dial out andπ' then hang up. It does show how to use interrupts to access a com port.ππ' --------- CUT HERE -------------------- CUT HERE ---------------------------πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM * BIOSCOM.BAS 8/26/1996 *πREM * Demo QB code to access a serial port via BIOS INT 14h using *πREM * QB\PDS. YOU MUST start QB\PDS with the /L command line switch to *πREM * allow QB to call BIOS interrupt 14H as in: QB BIOSCOM /L *πREM * *πREM * Maximum baud rate BIOS Int 14H reliably supports is 9600 BPS. *πREM * This demo program uses 9600 BPS on COM 2 with NO parity, one Stop *πREM * Bit and eight Data Bits. Modify as needed. - RAF *πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πDEFINT A-Z ' All untyped variables default to type integerπ'$INCLUDE: 'REGTYPE.BI'ππDECLARE SUB InitPort (PortNum%, BaudRate%)πDECLARE SUB GetStatus ()πDECLARE SUB Get1Byte (Byte$)πDECLARE SUB GetStr (Text$)πDECLARE SUB Send1Byte (Byte$)πDECLARE SUB SendStr (Text$)πDECLARE FUNCTION Dec2Bin$ (b%) ' Useful function for determining com parmsππDIM SHARED Registers AS RegTypeπDIM SHARED ComPort%, BaudRate%, Parity%, StopBits%, DataBits%ππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM * Example QB code to test BIOS INT 14H to access a serial port *πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *ππComPort% = 1 ' zero-based so 1 is actually com 2 (com 1 would be 0)πBaudRate% = 9600 ' 9600 BPS (max that BIOS INT 14H reliably supports)πParity% = 16 ' use NO parity 00010000πStopBits% = 0 ' use one Stop bit 00000x00πDataBits% = 3 ' use eight Data bits 00000011ππREM * * * * * * * * * * * * MAIN PROGRAM CODE * * * * * * * * * * * * * * *πCR$ = CHR$(13) ' ASCII code for carriage return\ENTERπESC$ = CHR$(27) ' ASCII code the the ESC keyπCLSπPRINTπCALL InitPort(ComPort%, BaudRate%)πPRINTπPRINT "Testing BIOS Interrupt 14H in QB\PDS to access a serial port."πPRINTπPRINT "Communications Port:" + STR$(ComPort% + 1)πPRINT "BPS Rate: " + STR$(BaudRate%)πPRINT "Resetting com port "; LTRIM$(STR$(ComPort% + 1)); "...";ππByteStr$ = ""πText$ = "ATZ" + CR$ ' initialize\reset modem to use modem profile 0πCALL SendStr(Text$)ππREM Wait for an OK from the modem that it received our modemπREM reset command.πDOπ CALL GetStr(Text$)πLOOP UNTIL INSTR(Text$, "OK") ' u might wanna check for error(s) hereπPRINT "done!"πPRINTπPRINTππREM Dial a number. Best to dial your own phone number here which willπREM ensure a BUSY signal and not annoy anyone.ππLINE INPUT "Enter your telephone number: "; Number$πIF Number$ = "" THEN Number$ = "555-1212" ' Information please? <g>πPRINTπText$ = "ATDT" + Number$ + CR$ ' ATDT touch tone line (ATDP for pulse line)πCALL SendStr(Text$) ' And dial outππREM Wait for a BUSY or CONNECT from the modem to be sure that the modemπREM received our DIAL command properly. In a real world program you wouldπREM need to check for other conditions like NO CARRIER, etc...πPRINT "Press ESC key to cancel"πPRINTπByteStr$ = ""πDOπ CALL Get1Byte(Byte$)π ByteStr$ = ByteStr$ + Byte$π PRINT Byte$;π AnyKey$ = INKEY$π IF AnyKey$ <> "" THEN EXIT DOπLOOP UNTIL INSTR(ByteStr$, "BUSY") OR INSTR(ByteStr$, "CONNECT")πPRINTπPRINT "Hanging up...";πText$ = "ATH0" + CR$ ' force the modem to hang upπCALL SendStr(Text$)πPRINT "All done Bubba!"πEND ' The End.πREM * * * * * * * * * * * * * THE END * * * * * * * * * * * * * * * * * * *ππREM * * * * * * * * * * * * * * * * * * * * * * * * *πREM Converts a decimal number into a binary string.πREM Called with: b% which is an integer variableπREM Returns: binary value of integer b%πREM * * * * * * * * * * * * * * * * * * * * * * * * *πFUNCTION Dec2Bin$ (b%) STATICπTemp$ = ""πH$ = HEX$(b%)πFOR I% = 1 TO LEN(H$)π Digit% = INSTR("0123456789ABCDEF", MID$(H$, I%, 1)) - 1π IF Digit% < 0 THENπ Temp$ = ""π EXIT FORπ END IFπ J% = 8π K% = 4π DO ' convert from hexadecimal to binaryπ Temp$ = Temp$ + RIGHT$(STR$((Digit% \ J%) MOD 2), 1)π J% = J% - (J% \ 2)π K% = K% - 1π IF K% = 0 THEN EXIT DOπ LOOP WHILE J%πNEXT I%πDec2Bin$ = Temp$πEND FUNCTIONπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM Receives one byte from active port via BIOS INT 14H - Function 2πREM Called with: AH = 2πREM DX = serial port 0 to 3 (zero-based)πREM Returns: AH = Line StatusπREM AL = Byte recievedπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB Get1Byte (Byte$)π PortFunc% = 2 ' Int 14H Function 2 = Read Char from portπ AL% = 0 ' zero-out, unused with this functionπ Registers.AX = AL% + (256 * PortFunc%)π Registers.DX = ComPort% ' com port (zero-based, com 1 is zero, etc...)π CALL INTERRUPT(&H14, Registers, Registers)π Byte$ = CHR$(Registers.AX AND 255) ' return string of ASCII char rec'dπEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM Reads line and modem status of the specified com portπREM Called with: AH = 3 ' function 3 (Get status) of INT 14HπREM DX = serial port 0 to 3 (zero-based)πREM Returns: AH = Line StatusπREM AL = Modem StatusπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB GetStatusπ AL% = 0 ' zero out AL register halfπ AH% = 3 ' Int 14H Function 3 = Read line and modem statusπ Registers.AX = AL% + (256 * AH%)π Registers.DX = ComPort% ' zero based active com port numberπ CALL INTERRUPT(&H14, Registers, Registers)π LineStat% = Registers.AX \ 256 ' extract AH from AX registerπ ModemStat% = Registers.AX AND 255 ' extract AL from AX registerπEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM Gets a string from the active com port one byte at a time usingπREM INT 14H's Get Byte function (2). *See Get1Byte SUBπREM Example: CALL GetStr(Text$)πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB GetStr (Text$)π DOπ CALL Get1Byte(Byte$)π Text$ = Text$ + Byte$π LOOP WHILE Byte$ <> CHR$(13) ' loop till a carriage return is rec'dπEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM Opens and initializes the com port via BIOS INT 14h (Function 0).πREM Registers set before calling:πREM AH = INT 14H function we want to invoke ( 0 = initialize port)πREM AL = Serial port initialization values (Baud, Parity...)πREM DX = com port number (zero based, 0 is com 1, 1 is com 2...)πREM Returns: AH = Line StatusπREM AL = Modem StatusπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB InitPort (ComPort%, BaudRate%)π SELECT CASE BaudRate% ' max baud via BIOS INT 14H is 9600 BPSπ CASE 9600π BaudVal% = 128 + 64 + 32 ' (224) = binary 11100000π CASE 2400π BaudVal% = 128 + 32 ' (160) = binary 10100000π CASE 1200π BaudVal% = 128 ' (128) = binary 10000000π CASE 300π BaudVal% = 64 ' (64) = binary 01000000π END SELECTπ ComParms% = BaudVal% + Parity% + StopBits% + DataBits%π PortFunc% = 0 ' Function 0 (of Int 14H) which is init portπ Registers.AX = ComParms% + (256 * PortFunc%)π Registers.DX = ComPort% ' active com port to init (zero-based)π CALL INTERRUPT(&H14, Registers, Registers) ' call the interruptπEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM Sends one byte to the specified serial port (zero based ComPort) via -πREM Function 1 of BIOS INT 14HπREM Called with: AH = 1πREM AL = ASCII value of the byte to sendπREM DX = Serial port 0 to 3 (zero based; use 0 for port 1...)πREM Returns: AH = Line StatusπREM AL = unchanged (the byte that was sent)πREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB Send1Byte (Byte$)π PortFunc% = 1 ' INT 14H Function 1 = write char to port goes into AHπ Byte% = ASC(Byte$) ' ASCII value of byte which goes into ALπ Registers.AX = Byte% + (256 * PortFunc%)π Registers.DX = ComPort% ' com port number (zero-based)π CALL INTERRUPT(&H14, Registers, Registers)πEND SUBππREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πREM Sends a string to the active com port one byte at a time usingπREM INT 14H's Send Byte function (1).πREM Called with: Text$ which is the string to send out the com port.πREM Example: CALL SendStr(Text$)πREMπREM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *πSUB SendStr (Text$)π FOR I% = 1 TO LEN(Text$)π OneByte$ = MID$(Text$, I%, 1)π CALL Send1Byte(OneByte$)π NEXT I%πEND SUBπ' --------- CUT HERE -------------------- CUT HERE ---------------------------πErik Bruggema REMOTE ACCESS UTILITIES immsstok@worldaccess.nl 08-28-96 (18:27) QB, QBasic, PDS 77 5021 RA_UTILS.BASDEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2πSUB V1:OPEN "O",1,"RA_UTILS.ZIP",4^6:Z&=3487:?STRING$(50,177);πU"%up()%9%%%I-%K'mAF8b1Cb6'7%%#-%%%1%%%%qf%xyhf%qqSg7fx&y1r^jUa95πU"lC)NGoP^*yRS5sCtz14__QAa(6G?.FJ2U[ZCia/aFxc7wEB-[)w;o&tBqNFGg6sπU"d5Xr8OmVQmnv=mUu%bG^)OuG+N1.I7]3;2_KP>Ur-uW*;p/Vhjx;K*3)t'm&-M?πU"Ej[V$s#e/mi+/j1ma2WCt#ovoEF98R=eb9)2cI+5^G(lQ7cCZ(Zn8V9\TT3.q;8πU"#3r#[]/%f8Odmse0D5L^M;m+w*H]RD;$+s#mA8+yC*F0o\M1Z0'bbj1>I]MDm#iπU"Fg9#ifJo8[<uTOwm9j;Z3f:Yo,0)zw>&4EGmcE700LxYBr:0bbEis?2^DH<.c[tπU"2oEtB#PuwwP5nFaaBoi:55hPJGArLckj0A4&E56IGY4C&QRbwh[$BJsAQ;0QU)1πU"T,SATHp9Y'bpNrmA3-'M<'$U+%D0/[VJN&LK6iF;S<^e:7)o8c%D/UVqO_(F;7wπU"OSDjBnoS^j?Vr7$V]VhL)V]1iQrI\pK3$vh-pi5+j6*qB,)FOAZ#_ru\B9PuqOKπU"Q]qbMQiN+Ia(r+q7m8mxTcC$6IB6S7DA'/>R2KbI7Z+'Jp9J=cE]th(v&Tc&)qbπU";Fgu59rS&[4rtyoW#pc_l8?n&X[F4etuk/(AHVJTcUdU.<QXS[DoVQRBf5J?hqxπU"%m&_iA^U,KuzrGcT:$3<-u;SJ94MMGxd441_1N#hO^dioId'KfxaSrN]+uT3--9πU"(O[B3lyvLup3fvfo:f*dPW2(rR[nJLD:)haD(^$100Z=)5l=9XN(Z('F-H.bb&TπU"J&Nup(%)9%%[%-%S[g#FXAR$(<[%%%e%%%%1%%%%q%fxyh%fqqS#ggx2c]iRKmxπU"-GDUT&dAh00Et+<9;[>Ph>s-?_HAu(RN3_,3b3>N9NaO.aB2%(Pa3#v\6s&=,HhπU"J+a6IP_8nvPn4zn'S'h$B&L&(=1xD]<wf*rD//U32///Z-))WWMS_[Cc*N-N&%HπU"k%%up()%9%%%I-%s%%AF2O&>kZ&.%%A'%%%0%#%%x(%xnsk%tSgf^xDvJ+o<U98πU"L4]D73zQO',Uj5p*pVKsvaKJL93^p$Ds=TuJ_:v]6r\0241-7ZG2pm&BtMN]OP+πU"*d;.^,_+dr4&p)M?FHnq90V&pePijTTFxR>Zny[.)4MkST2?VxpB;FDn=QD7rFPπU">se3C4v4*HcUc&VZg.4Jl3.UVc1u:M(nR+*5HC:i$9]2&.\vF-DwD;l^2Y+7ToPπU"0]o=yg#Gv/27^4#sei*x5]186/92vBV#z]61<kiM3B%[$/YCIl\W7C_V::k5)9lπU"&0>%mh.7K5:^<5:_GQ8xx:N_kkdMith/p]y[13ToWfok*WdRD48D26$pQ24##$lπU"7Mmm+$FAIlnv0;oaU[KR3kpV9l+W=G;tq4o6l&M)uydEJF$,dBKyr<QVoN;'(DuπU"p%()9%%%%-%%X-6F&9a,e%G%%%&w%%%%0%%%(x(xn%sktS[ggxF*9p2%[U-j:L<πU"3v/%Aa8y.HmMUG;XZIp+k1K\Is<8&Iup(%)9%%#%-%o&'AFzhuL1s['%%4%:%%0πU"%%%%y%nrjq%tlSgRfx&f<X>SUU5OX$BqDs;<L/c5c$uE%BKIMPLkQOa%qzDH59*πU"9>dm.LYi8.[SO3ilja,l9roeTUbZ4<-*HR\_SLQ)UZKNa$jYLrM=g&sV5RaqlRGπU"+9]TIYpqGa3X%ZYRHPDV-<kqCc.SEG*APg:a5Z*]j'=9bV=?nV+r3TrU<dL7ftJπU"K4TN#R?Dtvp\X/=>&(]48,mkuLj+V.4WcH4b7t5f3SAPD:Ye)AAOQ++ZaQHGDH0πU"A?)A3*;((HZQA<QSRYLD<y^F[Vlj$krrtWJuw7rLN-R:%7,(,SF35q%68F735/_πU")/iD#aJR9OjMBu)#kn[TUZ9luf)k<Wj9OwF4r)EPM[vo=5)cH?[RFxAhz*&4o.sπU"c0je$D6gdhsIsr]X603Y<[3+yIU]F4^EAm0.XiEn3RHh5DjgA0(opF\46:,gfp#πU"=<*3?8NGXF)EohrxxWHtxp'Oq0KjS43E%.LqqGkgay>sF.N[OqHgNHC\?((Hxx:πU"$_\+,G)VYFK71V#5\B2VHa5l2*&pF;=\1Hxg7(xIy.>Yd++r.fx,#IyB(Yd,rBnπU"fxPBIyF0_y_U3h2y_Y1OsuQOD[_9a'kF'$Y9_j^F.ZSNV1dUko7$SZqSWy_pMe$πU"7;;ZQHtUb:B,#=vGF$0Z3W8Qji,za<#t=eE4D?>qK./GqY-g5T$Gf3>[5Yha+1:πU"WA>iZa1;V41Y-<N>SQDi7UAvXaeHZL1.G6qQ2.mXU_,2AW'Si6a[MO4[7K?m6[&πU"'+3=KB+S4m(C<2soBCT;Y['mrqY5)KA=ZSH+A$ZG[-m'tZ5/AhGZS1NAjZ[T3m1πU"Zu55AQqZS7AitZ[9dm=[5H;A][YS=A*.Q=Z*>0*YRU;[>QE)'=5IS\Cx5xD*QC=πU"Z*0**oRcTv#2UiMZOiXBgkqAwSv>38z&17bD>5%Qh51Rb>>?)'UhU*mMy1;f41)πU"^h>k>3i'Ul+UmsyL1n4k7S.x%%up()%9%%%7-%Sg##Fy-(,iI%%%%l%%%%0%%%%πU"yn%rjqt%lSggax\U)]IZULK.Y24M/3/5NY//1&O%kE/3'1qu9A9<*9YK+%%up(%πU")9%%%%-%S#&CFpB<DxE#'%%d%+%%/%%%%z%xjwt%sSgfCxLy,,>SU98Ll[d2+4bπU"ki/YM&)J'zz%&'io(hf)zSLY=:nr+4,mBVwvYKfi$A^STotBg27jc#Es?ua<w4wπU"*/Vh,B$n\J%6RTI5onefea?dfYR(h?87]=$bd#Q]$S4*>pfpk=b^^q0g,g'okcGπU"J4+vCp5twE_^$#$k9pn:,$'n4Nmd(H9;H'KK2yt',DA8j[yNde]gNJk1zx7<'flπU"8eZ(t6M\>7a9m70c7ipJ^3#c*,0NGUzd&Sfq\q+FmO/:Ot0#>v)M-$ScfInkTBgπU"5\Ei1EU_iF(p.u&+%N/oqz_d30$f)D2wZQ;xomrugNvWl[J^m*;XDTPqZ7cd]U,πU"=%U/GT,M?nd5,[K%mXdNxHHY1eChBo)^Eqr)R_5V?78Zj\Rf16Xth)49CKE?:5bπU",h[fJhc1<d#1m_Kw1)5.^HqpnPtvF.GRS9wYva\wA]LDu\,d=l'TwZS&PC+;S0PπU"KD_s78^6Sg_2f0X9e>%zMq8'XRiU&+SS$1OtC'\W6p\:wOeA.A[[A_YVVI,eO_SπU"-:8Z;PK^l/d0j.^CcpTdcw7CJfU59&z#&5k[\TG4v#^/2tH>3tT/lLXof8,TX0jπU"s+k6hk6KD>yxGfP?Ndq:NN$w<b.QuFNB0d4lFDp#8UE_n#SGb\.j*L(3eOTQm_^πU"yWh<$-AXWp;GBn/AsLrt*$uuzg4V2t'6dxcy-H?>H$2olB5^/P$>xa?a#3$=+cUπU"&o2)B^'130tH7J+TP^tYGx/BfXc,.[-J*6oLh$qAA7%ii?DUfOnj$J(khHrn9$EπU"YX1QoGRKa7-vWdu%p()9%%%%-+%Tg#UFx'),33%%+%O%%%%/%%%%zxj%wtsS#ggπU"x29iRKx=-GDTYNZ<G-km.[p+Ui)LH#;lh#NIU$wxZPFPwT4i_OxZe20m9rp1gxBπU"_HQ#BjLtF?#vb(OOcA6swt?9699hCu]h$bu$gcp$vUhpa,g(.sq?XsEQu)zIVUAπU"8[b.-tG.o4s]xVhlg6]=0t.E#%Y^P*E;NNF^s&Ela?wI#[LR'<P\pByn-x+de$nπU"jfcjfolYtQ3't4X;#TILUwDK2%,_u;Kbo7rrTj-o46(%%up&%'9%9%%%%-1%K'AπU"=F8bC)b6'%+%#-%%%1%%%%%%%%%&%E%%%%%%%%%q%fxyh%fqqS%gfxu%p&'9%%9πU"%%[%-%S[g#FXAR$(<[%%%e%%%%1%%%%%%%%%&%%E%%(%$'%%%qfx%yhfq%qSgg%πU"xup&%'9%9%%%%-1%s%A#F2O>%kZ&%(%A'%%%0%%%%%%%%%&%E%%%%M%(%%x&(xnπU"s%ktSg%fxup%&'9%%9%%%%-%X-.6F9a%,eG%.%%w%%%%0%%%%%%%%%&%%E%%%&UπU")%%(x(xn%sktS%ggxu%p&'9%%9%%#%-%o&'AFzhuL1s['%%4%:%%0%%%%%%%%%&πU"%%E%%+%J)%%%ynr%jqtl%Sgfx%up&'%9%9%%%%-%'Sg#FCy-,i%I%%%%l%%%%0%πU"%%%%%%%%&%E%7%%m,%%%yn%rjqt%lSgg%xup&%'9%9%%%%-%%S&C:Fp<D(xE'%(πU"%d+%%%/%%%%%%%%%&%E%%%%f%-%%z%xjwt%sSgf%xup&%'9%9%%%%-+%Tg#UFx'πU"),33%%+%O%%%%/%%%%%%%%%&%E[%%%X%/%%z%xjwt%sSgg%xup*%+%%%%%-%-+%πU"A&%+%:0%%%%%πEND SUBπCLOSE:IF S=194AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!πSUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32πIF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1πS=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUBπEgbert Zijlema PB MOUSE IMPLEMENTATION E.Zijlema@uni4nn.iaf.nl 08-14-96 (13:17) PB 923 27762 MOUSMENU.BAS' MOUSMENU.BAS : shows how to implement the mouse in your programπ' Author : Egbert Zijlema (E.Zijlema@uni4nn.iaf.nl)π' (up)Date : August 14, 1996π' Language : Power Basic 3.2π' Copyright status: Public Domainπππ' Credit:π' The routines written in assembly (mouse driver calls & SUB Box)π' are from Dave Navarro. They came with Power Basic 3.2π' (MOUSUNIT.BAS & SCRNUNIT.BAS - subdirectory PB32\EXAMPLE).ππ' To improve the mouse driver stuff, 3 flags have been added:π' 1. mflg.allow - to be set on start up. Driver present.π' 2. mflg.mouse - driver activated by user (options menu).π' 3. mflg.mseon - (mouse on) to avoid switching on/off the cursor moreπ' than once. This is rather crucial, due to the fact that the mouseπ' is counting, not toggling, its on/off status.ππ' I also implemented a slight modification in SUB Box, making itπ' possible to choose 1 out of 3 rectangles: single frame, double frame,π' no frame (inverse or clean background)ππ$COMPILE EXE ' compile the file if you might want to tryπ ' to exit to DOS (File-menu)πDEFINT A - Zππ%FALSE = 0 : %TRUE = NOT %FALSEππ' equates for arrow keys:π%HOME = 71 * 256 : %UP = 72 * 256 : %LEFT = 75 * 256π%RIGHT = 77 * 256 : %END = 79 * 256 : %DOWN = 80 * 256ππ' equates for command keysπ%TAB = 9 : %ENTER = 13 : %ESCAPE = 27ππ' equates for pulldown menusπ%ALTI = 23 * 256 ' open info menuπ%ALTO = 24 * 256 ' open options menuπ%ALTF = 33 * 256 ' open file menuπ%ALTX = 45 * 256 ' exit programπ%F1 = 59 * 256 ' help screenππTYPE GENERICFLAGSπ mono AS INTEGER ' monochrome cardπ menu AS INTEGER ' scroll menuπ clok AS INTEGER ' time on/offπEND TYPEπDIM flag AS SHARED GENERICFLAGSππTYPE MOUSEFLAGSπ allow AS INTEGER ' driver presentπ mouse AS INTEGER ' driver activeπ mseon AS INTEGER ' mouse cursor on/offπEND TYPEπDIM mflg AS SHARED MOUSEFLAGSππfilemenudata:π DATA 4, 3π DATA " *Select "π DATA " *Dos "π DATA " E*xit Alt-X "ππinfomenudata:π DATA 11, 3π DATA " *Help F1 "π DATA " *Read Me "π DATA " *About "ππhelpdata:π DATA "HOT KEYS:"π DATA "F1 : Display this helpscreen"π DATA "Alt-x : Exit"π DATA "Alt-f : Open File-menu"π DATA "Alt-i : Open Info-menu"π DATA "Alt-o : Open Options-menu"π DATA ""π DATA "Esc : Cancel any operation"π DATA "Tab : Toggle yes/no in dialog box"ππaboutdata:π DATA "MOUSE DEMO"π DATA "Author: Egbert Zijlema"π DATA "Status: Public Domain"ππreadmedata:π DATA "MOUSE DIFFICULTIES"π DATA "Routines concerning the mouse are basically very simple. They are"π DATA "all done by calling INTERRUPT &H33. Depending of the value passed"π DATA "through the AX-register, one can test for the presence of the"π DATA "mouse, show/hide its cursor, define a screen area; and so on."π DATA ""π DATA "But unfortunately all those routines don't tell you how to"π DATA "implement the mouse in your program. How, for instance, do you tell"π DATA "your software that clicking the word File in the menu bar means"π DATA "the same as pressing Alt-f (to pull down the File menu)?"π DATA "This demo shows how to manipulate pull down menus and how to select"π DATA "a file from a list of 30 filenames (out of an array of 60) - either"π DATA "by the mouse or the arrow keys."ππDIM VideoAddress AS SHARED INTEGERπDIM MainScreen AS SHARED STRING ' initial screenπDIM FileName(1 : 60) AS SHARED STRINGππIF (pbvScrnCard AND 1) = 0 THENπ VideoAddress = &HB800 ' color cardπELSEπ VideoAddress = &HB000 ' monochromeπ flag.mono = %TRUEπEND IFππIF MsThere THENπ mflg.allow = %TRUE ' mouse presentπ mflg.mouse = %TRUE ' mouse activeπ DIM matrix(1 : 25, 1 : 80) AS SHARED INTEGER ' screen matrixπEND IFππFUNCTION MsThere AS INTEGERπ ! push DS ; save DS for PowerBASICπ ! xor AX, AX ; clear AXπ ! int &H33 ; call mouse driverπ ! xor BX, BX ; clear BX, assume no mouse presentππ ! or AX, AX ; does AX = 0?π ! jz MsThereDone ; yes, we're doneπ ! dec BX ; no, make it -1πMsThereDone:π ! mov FUNCTION, BX ; put BX in RetVal variableπ ! pop DS ; restore DSπEND FUNCTIONππFUNCTION GetMouseOrKeyπ STATIC t$ ' actual timeπ MsStatus oldButn, oldRow, oldColπ IF oldButn = 1 THEN oldKey = matrix(oldRow, oldCol) ' avoid repeatingπ DOππ IF t$ <> TIME$ THENπ t$ = TIME$π IF flag.mono THEN COLOR 0, 7 ELSE COLOR 15, 7π LOCATE 1, 72, 0π IF flag.clok THEN PRINT t$ ELSE PRINT SPACE$(8)π END IFππ MsStatus buttons, row, colππ IF INSTAT THENπ FUNCTION = CVI( INKEY$ + CHR$(0) )π EXIT FUNCTIONπ ELSEIF (buttons = 1) AND ( matrix(row, col) <> oldKey ) THENπ FUNCTION = matrix(row, col)π EXIT FUNCTIONπ ELSEIF buttons > 1 THEN ' right butn = Escapeπ FUNCTION = %ESCAPEπ EXIT FUNCTIONπ END IFππ LOOP UNTIL (oldButn = 1) AND (buttons = 0) ' until releasing left butnπ FUNCTION = %ENTERπEND FUNCTIONππSUB WaitForInputπ DOπ MsStatus buttons, dummy, dummyπ LOOP UNTIL LEN(INKEY$) OR buttonsπ MsLocate 1, 1πEND SUBππSUB MsCursorOnπ IF mflg.mouse = %FALSE THEN EXIT SUB ' no mouse, so quitπ IF mflg.mseon = %FALSE THEN ' only when mouse is offπ ! push DS ; save DS for PowerBASICπ ! mov AX, 1 ; mouse driver function 1, turn on cursorπ ! int &H33 ; call driverπ ! pop DS ; restore DSπ mflg.mseon = %TRUE ' mouse cursor onπ END IFπEND SUBππSUB MsCursorOffπ IF mflg.mouse = %FALSE THEN EXIT SUBπ IF mflg.mseon THENπ ! push DS ; save DS for PowerBASICπ ! mov AX, 2 ; mouse driver function 2, turn off cursorπ ! int &H33 ; call driverπ ! pop DS ; restore DSπ mflg.mseon = %FALSE ' mouse cursor offπ END IFπEND SUBππSUB MsLocate(BYVAL row AS INTEGER, BYVAL col AS INTEGER)π IF mflg.mouse = %FALSE THEN EXIT SUBπ IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THENπ row = (row - 1) * 8π col = (col - 1) * 8π END IFππ ! push DS ; save DS for PowerBASICπ ! mov AX, &H04 ; function 04h, set mouse locationπ ! mov CX, col ; put column in CXπ ! mov DX, row ; put row in DXπ ! int &H33 ; call mouse interruptπ ! pop DS ; restore DS for PowerBASICπEND SUBππSUB MsStatus(buttons AS INTEGER, row AS INTEGER, col AS INTEGER)π IF mflg.mouse = %FALSE THEN EXIT SUBπ ! push DS ; save DS for PowerBASICπ ! mov AX, &H03 ; function 03h, get mouse statusπ ! int &H33 ; call mouse interruptπ ! les DI, buttons ; point ES:DI to buttonsπ ! mov ES:[DI], BX ; put active button(s) in variableπ ! les DI, row ; point ES:DI to Rowπ ! mov ES:[DI], DX ; put mouse row in variableπ ! les DI, col ; point ES:DI to Columnπ ! mov ES:[DI], CX ; put mouse column in variableπ ! pop DS ; restore DS for PowerBASICππ IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THENπ row = (row \ 8) + 1 ' if text mode, then fix coordinatesπ col = (col \ 8) + 1π END IFπEND SUBππSUB MsSetWindow(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, _π BYVAL Rows AS INTEGER, BYVAL Cols AS INTEGER)ππ IF mflg.mouse = %FALSE THEN EXIT SUBπ Rows = Row + Rows - 1 ' adjust rows to real coordinatesπ Cols = Col + Cols - 1 ' adjust cols to real coordinatesππ IF (pbvScrnMode = 7) OR (pbvScrnMode = 0) THENπ Row = Row * 8 ' if text mode, adjust coordinatesπ Rows = Rows * 8π Col = Col * 8π Cols = Cols * 8π END IFππ ! push DS ; save DS for PowerBASICπ ! mov CX, Row ; put start row in CXπ ! mov DX, Rows ; put end row in DXπ ! mov AX, &H08 ; function 08h, set vertical limitπ ! int &H33 ; call mouse interruptπ ! mov CX, Col ; put start column in CXπ ! mov DX, Cols ; put end column in DXπ ! mov AX, &H07 ; function 07h, set horizontal limitπ ! int &H33 ; call mouse interruptπ ! pop DS ; restore DS for PowerBASICπEND SUBππSUB Box(BYVAL Row AS INTEGER, BYVAL Col AS INTEGER, BYVAL Rows AS INTEGER, _π BYVAL Cols AS INTEGER, BYVAL Shape AS INTEGER, BYVAL Attr AS BYTE)ππ ' draw a rectangleπ ' original from Power Basic Inc.π ' modified by Egbert Zylema (NL)ππ SELECT CASE Shapeππ CASE 1ππ ' draw single rectangleπ TL.Char? = 218 ' ┌π TR.Char? = 191 ' ┐π BL.Char? = 192 ' └π BR.Char? = 217 ' ┘π Hor? = 196 ' ─π Vert? = 179 ' │ππ CASE 2ππ ' draw double rectangleπ TL.Char? = 201 ' ╔π TR.Char? = 187 ' ╗π BL.Char? = 200 ' ╚π BR.Char? = 188 ' ╝π Hor? = 205 ' ═π Vert? = 186 ' ║ππ CASE 0ππ ' background without frameπ ' cleans the area when attri is set to zeroπ TL.Char? = 32π TR.Char? = 32π BL.Char? = 32π BR.Char? = 32π Hor? = 32π Vert? = 32π END SELECTππ ! push DS ; save DSππ ! mov AX, VideoAddress ; put screen segment in AXπ ! mov ES, AX ; and in ESππ ! mov AX, Row ; put row in AXπ ! dec AX ; minus oneπ ! mov CX, 160 ; AX =π ! mul CX ; AX * 160π ! mov DI, AX ; put it in DIπ ! mov AX, Col ; put column in AXπ ! dec AX ; minus oneπ ! shl AX, 1 ; times 2π ! add DI, AX ; add to DIππ ! mov DX, Rows ; put rows in DXπ ! dec DX ; minus top rowπ ! dec DX ; minus bottom rowππ ! mov CX, Cols ; put columns in CXπ ! dec CX ; minus left columnπ ! dec CX ; minus right columnππ ! mov AH, Attr ; put attribute in AHππ ! push CX ; save CX (columns)π ! push DI ; and DI (screen location)π ! mov AL, TL.Char? ; put top left char in ALπ ! stosw ; write it to the screenπ ! mov AL, Hor? ; put top char in ALπ ! rep stosw ; write it to the screen CX timesπ ! mov AL, TR.Char? ; put top right char in ALπ ! stosw ; write it to the screenπ ! pop DI ; restore DIπ ! pop CX ; and CXππHorizLoop:π ! add DI, 160 ; move to next row on the screenπ ! push CX ; save CXπ ! push DI ; and DIπ ! mov AL, Vert? ; put left char in ALπ ! stosw ; write it to the screenπ ! mov AL, 32 ; put a space in ALπ ! rep stosw ; write it to the screen CX timesπ ! mov AL, Vert? ; put right char in ALπ ! stosw ; write it to the screenπ ! pop DI ; restore DIπ ! pop CX ; and CXπ ! dec DX ; one less rowπ ! jnz HorizLoop ; loop until DX (rows) = 0ππ ! add DI, 160 ; move to next row on the screenπ ! mov AL, BL.Char? ; put bottom left char in ALπ ! stosw ; write it to the screenπ ! mov AL, Hor? ; put bottom char in ALπ ! rep stosw ; write it to the screen CX timesπ ! mov AL, BR.Char? ; put bottom right char in ALπ ! stosw ; write it to the screenππ ! pop DS ; restore DS for PowerBASICπEND SUBππSUB repaint(row, col, attri, length)π start = (row - 1) * 160 + (col - 1) * 2π finish = start + (length - 1) * 2π DEF SEG = VideoAddressπ FOR offset = start TO finish STEP 2π POKE offset + 1, attri ' color offsetπ NEXTπ DEF SEGπEND SUBππFUNCTION YesNo(header$)π MsCursorOffπ IF flag.mono THEN attri = 15 ELSE attri = 63π question$ = "Are you sure?"π IF LEN(question$) < LEN(header$) THENπ length = LEN(header$)π ELSEπ length = LEN(question$)π END IFπ col = (80 - length) \ 2π Box 10, col - 2, 7, length + 4, 2, attriπ Box 13, 33, 3, 13, 1, attriπ COLOR attri MOD 16, attri \ 16π LOCATE 11, col : PRINT header$π LOCATE 12, col : PRINT "Are you sure?"π LOCATE 13, 39 : PRINT CHR$(194) ' ┬π LOCATE 14, 34 : PRINT " Yes ";CHR$(179);" No " ' │π LOCATE 15, 39 : PRINT CHR$(193) ' ┴π IF flag.mono THENπ repaint 14, 36, 7, 3 ' normal white (initials are intense)π repaint 14, 42, 7, 1π ELSEπ repaint 14, 35, 62, 1 ' initials yellow on cyaneπ repaint 14, 41, 62, 1π END IFπ DEF SEG = VideoAddressπ YesNoScrn$ = PEEK$(160, 3840)π DEF SEGππ init = %TRUE : result = %FALSEπ ERASE matrixπ FOR cell = 34 TO 38π matrix(14, cell) = ASC("Y")π NEXTπ FOR cell = 40 TO 44π matrix(14, cell) = ASC("N")π NEXTπ MsSetWindow 12, col - 2, 2, length + 2π DOπ MsCursorOnπ IF init THENπ init = %FALSEπ KeyIn = %TABπ ELSEπ KeyIn = GetMouseOrKeyπ END IFπ SELECT CASE KeyInπ CASE ASC("Y"), ASC("y")π result = %TRUEπ KeyIn = %ENTERπ CASE ASC("N"), ASC("n"), %ESCAPEπ result = %FALSEπ KeyIn = %ENTERπ CASE %TABπ IF result THENπ result = %FALSE : offset = 40π ELSEπ result = %TRUE : offset = 34π END IFπ END SELECTπ MsCursorOffπ DEF SEG = VideoAddressπ POKE$ 160, YesNoScrn$π DEF SEGπ repaint 14, offset, 15, 5π IF flag.mono THENπ repaint 14, offset, 112, 5 ' inverseπ ELSEπ repaint 14, offset + 1, 14, 1 ' yellowπ END IFπ LOOP UNTIL KeyIn = %ENTERπ FUNCTION = resultπ MainMatrixπEND FUNCTIONππ' ............... end of library routines ........................ππSUB MainMatrixπ ERASE matrixπ CALL MenuBarMatrixπ row = 3 : col = 4π FOR count = 1 TO 30 ' 30 files displayedπ FOR cell = col TO col + 11 ' length = 12π matrix(row, cell) = count + 256 ' no ASCII valuesπ NEXTπ INCR col, 14π IF col = 74 THENπ INCR row : col = 4π END IFπ NEXTππ FOR cell = 1 TO 80 ' mouse out of boundsπ matrix(2, cell) = %UP ' to simulate up &π matrix(9, cell) = %DOWN ' down arrowπ NEXTπEND SUBππSUB MenuBarMatrixπ FOR cell = 5 TO 8π matrix(1, cell) = %ALTFπ matrix(1, cell + 7) = %ALTIπ NEXTπ FOR cell = 19 TO 25π matrix(1, cell) = %ALTOπ NEXTπEND SUBππSUB DrawMenuBarπ SHARED bar$π COLOR 0, 7π LOCATE 1, 1 : PRINT SPACE$(80);π LOCATE 1, 5 : PRINT "File Info Options"π IF flag.mono = %FALSE THENπ repaint 1, 5, 116, 1π repaint 1, 12, 116, 1π repaint 1, 19, 116, 1π END IFπ DEF SEG = VideoAddressπ bar$ = PEEK$(0, 50)π DEF SEGπEND SUBππSUB DrawMainScreenπ shape = 2 ' double frameπ attri = 15 ' intense whiteπ start = 1 ' record to start withπ total = 30 ' 30 recordsπ Box 2, 1, 20, 80, shape, attri ' draw rectangleππ CollectFileNamesπ DisplayFiles start, totalππ DEF SEG = VideoAddressπ MainScreen = PEEK$(160, 3840) ' exclude menubarπ DEF SEGπ COLOR 7,0π LOCATE 25, 4π PRINT "Press F1 for help";πEND SUBππSUB CollectFileNamesπ FileToFind$ = DIR$("C:\DOS\*.*")π DO WHILE LEN(FileToFind$)π INCR countπ FileName(count) = FileToFind$ + SPACE$(12 - LEN(FileToFind$))π IF count = UBOUND(FileName) THEN EXIT DO ' don't exceed 60π FileToFind$ = DIR$π LOOPπ ARRAY SORT FileName() ' alfabetic orderπEND SUBππSUB DisplayFiles(start, total)π COLOR 15, 0π row = 3 : col = 4π FOR count = start TO start + total - 1π LOCATE row, colπ PRINT FileName(count)π INCR col, 14π IF col = 74 THENπ INCR row : col = 4π END IFπ NEXTπEND SUBππSUB DosEscapeπ IF BIT(pbvHost, 5) <> 0 THEN EXIT SUB ' don't try this in the IDEπ DefaultDir$ = CURDIR$π DEF SEG = VideoAddressπ OldScreen$ = PEEK$(0, 4000)π COLOR 7, 0π CLSπ LOCATE 1, 1π PRINT "Type EXIT and press ENTER to return..."π SHELLππ ' restore drive and directoryπ IF LEFT$(CURDIR$, 2) <> LEFT$(DefaultDir$, 2) THENπ CHDRIVE LEFT$(DefaultDir$, 2)π END IFπ IF CURDIR$ <> DefaultDir$ THEN CHDIR DefaultDir$π POKE$ 0, OldScreen$π DEF SEGπEND SUBππSUB ShowTextπ IF flag.mono THEN attri = 112 ELSE attri = 94π Box 5, 5, 15, 69, 0, attriπ COLOR attri MOD 16, attri \ 16π RESTORE readmedataπ FOR count = 1 TO 13π READ me$π LOCATE count + 5, 6 : PRINT me$π NEXTπ LOCATE 14, 43 : PRINT CHR$(34)π LOCATE 14, 48 : PRINT CHR$(34)π WaitForInputπEND SUBππSUB Aboutπ IF flag.mono THEN attri = 112 ELSE attri = 78π Box 3, 10, 5, 26, 1, attriπ COLOR attri MOD 16, attri \ 16π RESTORE aboutdataπ FOR count = 1 TO 3π READ abt$π LOCATE count + 3, 12 : PRINT abt$π NEXTπ WaitForInputπEND SUBππSUB HelpTextπ IF flag.mono THEN attri = 112 ELSE attri = 31π Box 3, 10, 11, 39, 1, attriπ COLOR attri MOD 16, attri \ 16π RESTORE helpdataπ FOR count = 1 TO 9π READ help$π LOCATE count + 3, 12 : PRINT help$π IF flag.mono = %FALSE AND count > 1 THENπ repaint count + 3, 12, 30, 5 ' yellow on blueπ END IFπ NEXTπ WaitForInputπEND SUBππSUB DrawMenu(menu$(), options, column, length, letter$)π shape = 1π flag.menu = %TRUEπ IF flag.mono THEN attri = 112 ELSE attri = 127π rows = UBOUND(menu$) + 2π cols = LEN(menu$(1)) + 1 ' + 2 - 1 (asterix)π MsSetWindow 0, 0, options + 2, 28π ERASE matrixπ MenuBarMatrixπ MsCursorOffπ repaint 1, column + 1, 12, 1π repaint 1, column + 2, 7, length - 1π Box 2, column - 1, rows, cols, shape, attriπ COLOR attri MOD 16, attri \ 16π FOR count = 1 TO UBOUND(menu$)π split = INSTR(menu$(count), "*")π PartTwo$ = MID$(menu$(count), split + 1)π letter$ = letter$ + UCASE$(LEFT$( PartTwo$, 1) )π offset = column + split - 1π LOCATE count + 2, columnπ PRINT LEFT$(menu$(count), split - 1) + partTwo$ππ IF flag.mono = %FALSE THENπ repaint count + 2, offset, attri + 4 - attri MOD 16, 1 ' redπ END IFππ FOR cell = column TO column + cols - 3π matrix(count + 2, cell) = count + 256π NEXTπ NEXTπEND SUBππSUB FileMenu(choice)π RESTORE filemenudataπ READ column, optionsπ REDIM MenuItem(1 : options) AS LOCAL STRINGπ FOR count = 1 TO optionsπ READ MenuItem(count)π NEXTπ length = 4π DrawMenu MenuItem(), options, column, length, letter$π InRow = 1 ' 1 per rowπ exclude = %ALTFπ length = LEN( MenuItem(1) ) - 1 ' minus asterixπ ScrollMenu letter$, options, InRow, column, exclude, length, resultπ SELECT CASE resultπ CASE 1π ScreenMenuπ CASE 2π MsCursorOffπ DosEscapeπ CASE 3π ' return result to main menu to avoid recursionπ choice = %ALTXπ CASE %LEFT, %ALTOπ choice = %ALTOπ CASE %RIGHT, %ALTIπ choice = %ALTIπ END SELECTπEND SUBππSUB InfoMenu(choice)π RESTORE infomenudataπ READ column, optionsπ REDIM MenuItem(1 : options) AS LOCAL STRINGπ FOR count = 1 TO optionsπ READ MenuItem(count)π NEXTπ length = 4π DrawMenu MenuItem(), options, column, length, letter$π InRow = 1 ' 1 per rowπ exclude = %ALTIπ length = LEN( MenuItem(1) ) - 1 ' minus asterixπ ScrollMenu letter$, options, InRow, column, exclude, length, resultπ SELECT CASE resultπ CASE 1π choice = %F1π CASE 2π MsCursorOffπ ShowTextπ CASE 3π MsCursorOffπ Aboutπ CASE %RIGHT, %ALTOπ choice = %ALTOπ CASE %LEFT, %ALTFπ choice = %ALTFπ END SELECTπEND SUBππSUB OptionsMenu(choice)π IF mflg.allow THEN options = 2 ELSE options = 1π REDIM MenuItem(1 : options) AS LOCAL STRINGππ IF flag.clok THEN extra$ = "ff " ELSE extra$ = "n "π MenuItem(1) = " *Time o" + extra$π IF options = 2 THENπ IF mflg.mouse THEN plus$ = "ff " ELSE plus$ = "n "π MenuItem(2) = " *Mouse o" + plus$π END IFπ column = 18π length = 7π DrawMenu MenuItem(), options, column, length, letter$π InRow = 1π exclude = %ALTOπ length = LEN( MenuItem(1) ) - 1 ' minus asterixπ ScrollMenu letter$, options, InRow, column, exclude, length, resultπ question$ = "Time to be switched off!"π SELECT CASE resultπ CASE 1π IF flag.clok THENπ IF YesNo(question$) THEN flag.clok = %FALSEπ ELSEπ flag.clok = %TRUEπ END IFπ CASE 2π IF mflg.allow = %FALSE THEN EXIT SELECTπ IF mflg.mouse THEN mflg.mouse = %FALSE ELSE mflg.mouse = %TRUEπ MsLocate 1, 1π CASE %LEFT, %ALTIπ choice = %ALTIπ CASE %RIGHT, %ALTFπ choice = %ALTFπ END SELECTπEND SUBππSUB ScreenMenuπ STATIC FirstChar$π MainMatrixπ IF FirstChar$ = "" THENπ FOR count = 1 TO UBOUND(FileName)π FirstChar$ = FirstChar$ + LEFT$(FileName(count), 1)π NEXTπ END IFπ options = UBOUND(FileName)π InRow = 5π column = 4π exclude = 0π length = LEN( FileName(1) )π MsSetWindow 0, 0, 9, 80π ScrollMenu FirstChar$, options, InRow, column, exclude, length, resultπ MsCursorOffπ COLOR 15, 0π LOCATE 20, 4 : PRINT "You selected ";π IF result THENπ PRINT FileName(result);π COLOR 7π LOCATE 25, 4 : PRINT "Press any key or click mouse button";π WaitForInputπ END IFπEND SUBππSUB ScrollMenu(letter$, options, InRow, column, exclude, length, result)π SHARED bar$ ' see: DrawMenuBarππ ' LEGEND:π ' letter$ = marked characters of menu optionsπ ' options = number of array elementsπ ' InRow = elements per rowπ ' column = first columnπ ' exclude = value of the key that opened the menuπ ' length = length of each elementππ first = 1 ' first element main screenπ IF flag.menu THEN ' menu scrollingπ total = options ' all options on screenπ between = 0 ' no spacesπ ELSE ' screen scrollingπ init = %TRUEπ total = 30 ' 30 filenamesπ between = 2 ' 2 spaces in betweenπ END IFππ DEF SEG = VideoAddressπ MenuScrn$ = PEEK$(160, 3840) ' initial screenπ DEF SEGπ MsCursorOnππ DOπ IF init THENπ init = %FALSEπ action = %RIGHTπ ELSEπ action = GetMouseOrKeyπ END IFπ SELECT CASE actionπ CASE %ESCAPEπ result = 0π EXIT DOπ CASE 65 TO 90, 97 TO 122π match = INSTR( letter$, UCASE$(CHR$(action)) )π IF match THENπ result = matchπ IF flag.menu THEN EXIT DOπ END IFπ CASE %LEFT, %RIGHTπ IF flag.menu THENπ result = actionπ EXIT DOπ ELSEπ CALL LeftRight(action, result, options)π END IFπ CASE %UP, %DOWNπ MsStatus buttons, row, colπ UpDown action, row, InRow, options, result, cursorπ IF (buttons = 1) AND (cursor > 2) THEN MsLocate cursor, colπ CASE %HOME, %ENDπ IF action = %HOME THEN result = 1 ELSE result = optionsπ CASE 257 TO total + 256π result = action + first - 257π CASE %ALTF, %ALTI, %ALTOπ IF flag.menu = %FALSE THEN EXIT SELECTπ IF action = exclude THEN result = 0 ELSE result = actionπ IF result THEN EXIT DOπ END SELECTπ MsCursorOffππ ' do we need to refresh the main screen?π IF flag.menu = %FALSE THENπ IF refresh(result, first, total, InRow) THENπ DisplayFiles first, totalπ DEF SEG = VideoAddressπ MenuScrn$ = PEEK$(160, 3840)π DEF SEGπ END IFπ END IFππ DEF SEG = VideoAddressπ POKE$ 160, MenuScrn$π DEF SEGππ IF result THENπ row = (result - first) \ InRow : INCR row, 3π col = ( (result - first) MOD InRow ) * (length + between)π INCR col, columnπ IF flag.menu THEN attri = 7 ELSE attri = 112π repaint row, col, attri, lengthπ END IFπ MsCursorOnπ LOOP UNTIL action = %ENTERπ MsCursorOffπ IF flag.menu THENπ DEF SEG = VideoAddressπ POKE$ 0, bar$π POKE$ 160, MainScreenπ DEF SEGπ flag.menu = %FALSEπ END IFπEND SUBππSUB LeftRight(action, result, options)π SELECT CASE actionπ CASE %LEFT : IF result > 1 THEN DECR resultπ CASE %RIGHT : IF result < options THEN INCR resultπ END SELECTπEND SUBππSUB UpDown(action, row, InRow, options, result, cursor)π old = resultπ SELECT CASE actionπ CASE %UPπ DECR result, InRowπ cursor = row + 1π CASE %DOWNπ INCR result, InRowπ cursor = row - 1π END SELECTπ SELECT CASE resultπ CASE < 1π IF flag.menu THEN result = options ELSE result = oldπ CASE > optionsπ IF flag.menu THEN result = 1 ELSE result = oldπ END SELECTπEND SUBππFUNCTION refresh(result, first, total, InRow)π SELECT CASE resultπ CASE 0π FUNCTION = %FALSEπ EXIT FUNCTIONπ CASE => first + totalπ DO WHILE result => first + totalπ INCR first, InRowπ LOOPπ FUNCTION = %TRUEπ CASE < firstπ DO WHILE result < firstπ DECR first, InRowπ LOOPπ FUNCTION = %TRUEπ CASE ELSEπ FUNCTION = %FALSEπ END SELECTπEND FUNCTIONππSUB MainMenuπ DOπ IF choice THENπ KeyIn = choiceπ choice = 0π ELSEπ KeyIn = GetMouseOrKeyπ END IFπ SELECT CASE KeyInπ CASE %ALTXπ IF YesNo("Quitting demo") THENπ MsCursorOffπ COLOR 7, 0π CLSπ SYSTEMπ END IFπ CASE %F1 : Helptextπ CASE %ALTI : InfoMenu choiceπ CASE %ALTF : FileMenu choiceπ CASE %ALTO : OptionsMenu choiceπ END SELECTπ MsCursorOffπ DEF SEG = VideoAddressπ POKE$ 160, MainScreenπ DEF SEGπ MsSetWindow 0, 0, 25, 80π MsCursorOnπ LOOPπEND SUBππ' sample mainπCLSπ flag.clok = %TRUE ' time onπ DrawMenuBarπ DrawMainScreenπ MainMatrixπ MsLocate 1, 1π MsCursorOnπ MainMenuπENDπEgbert Zijlema SPLIT SCREEN COLOR ATTRIBUTE E.Zijlema@uni4nn.iaf.nl 08-05-96 (16:52) PB 77 1828 SPLITCLR.BAS' SPLITCLR.BAS - splits the screen color attribute in fore- and backgroundπ' the demo shows 2 methods, use the 1 you preferππ' Author : Egbert Zijlema (E.Zijlema@uni4nn.iaf.nl)π' Date : August 5, 1996π' Copyright status: Public DomainππDEFINT A-ZππCLSπ row = 10π col = 10π text$ = " Egbert"π COLOR 14, 4 ' yellow on redπ LOCATE row, colπ PRINT text$ππ ' show result on next row (after 2 seconds)π SLEEP 2π FOR action = 1 TO LEN(text$)π SplitColor row, col, character$, fore, backπ LOCATE row + 1, colπ COLOR fore, backπ PRINT character$π INCR colπ DELAY .1 ' just for the demoπ NEXTππ COLOR 7, 0π LOCATE 25, 1π PRINT "Press any key to proceed";π DOπ LOOP UNTIL LEN(INKEY$)π LOCATE 25, 1π PRINT SPACE$(80);ππ ' now let's use the video segmentπ VidSeg = &HB800 ' assume color cardπ row = 10π text$ = " Zijlema "π COLOR 14, 4π LOCATE row, colπ PRINT text$ππ DELAY 2π FOR action = 1 TO LEN(text$)π CALL ColorSplit(row, col, character, attri)π offset = row * 160 + (col - 1) * 2 ' next row!π DEF SEG = VidSegπ POKE offset, characterπ POKE offset + 1, attriπ DEF SEGπ INCR colπ DELAY .1π NEXTπ COLOR 7, 0 ' restore defaultπ LOCATE 10, 10: PRINT SPACE$(16);πENDππSUB SplitColor (row, col, character$, fore, back)π ' using POWER BASIC's SCREEN functionπ char = SCREEN(row, col)π character$ = CHR$(char)π attri = SCREEN(row, col, 1)π fore = attri MOD 16π back = attri \ 16πEND SUBππSUB ColorSplit (row, col, character, attri)π ' using video segmentπ SHARED VidSegπ DEF SEG = VidSegπ offset = (row - 1) * 160 + (col - 1) * 2π character = PEEK(offset)π attri = PEEK(offset + 1)π DEF SEGπEND SUBπJohn Fischer HAPPY BIRTHDAY SONG FidoNet QUIK_BAS Echo 07-10-96 (23:52) QB, QBasic, PDS 7 274 HAPBIRTH.BAS' > I was wondering if you could give some source code for Qbasic thatπ' > will play "happy birthday"...ππ'Happy Birthday to YouπPLAY "MNT150L8O4CCL4DCFL2EL8CCL4DCGL2FL8CCL4>C<AFEL2DL8A+A+"πPLAY "L4AFGL2FL8CCL4DCFL2EL8CCL4DCGL2FL8CCL4>C<AFEL2DL8A+A+"πPLAY "L4AFGL2F"πJohn Fischer MORE THEME SONGS FidoNet QUIK_BAS Echo 07-14-96 (00:47) QB, QBasic, PDS 61 3127 THEMES.BAS ' > Do any of you know how to play QUICKBASIC music in the background of aπ' > program?ππ'I believe that MB in the play statement switches it to BACKGROUND and MFπ'switches it to FOREGROUND playing. Check out your HELP on PLAY.ππ' > Also, do any of you got any good QUICKBASIC music with the PLAYπ' > command, (Like the Happy Birthday thing I saw)ππREM The Adaams Family Movie ThemeπPLAY "MNT200L8O3CDEFP4L4FP8FP8L8DEF+GP4L4O1GP8GP8L8O3DEF+GP4"πPLAY "DEF+GP4CDEFP4L4O1FP8FP8P4L8O3CF.AF.D<A+.>GP4FE.GE.C<A."πPLAY ">FP4CF.AF.D<A+.>GP4FL64EFL8E.CD.EFP4CDEFP4L4FP8FP8L8D"πPLAY "EF+GP4L4O1GP8GP8L8O3DEF+GP4DEF+GP4CDEFP4L4O1FP8FP8P4L8O3C"πPLAY "F.AF.D<A+.>GP4FE.GE.C<A.>FP4CF.AF.D<A+.>GP4FL64EFL8E."πPLAY "CD.EFP4"ππREM Flash Dance ThemeπPLAY "MNT150L2O3E.L8DCL2D.L8DEL2F.L8EEEDL2CL8DCL2A.L8GFL2G."πPLAY "L8FGFEL2DL4CL2D.L8CDL2E.L8DCL2D.L8DEL2F.L8EEEDL4CP4L8D"πPLAY "CL2A.L8GFL2G.L8FGFEL4DL8>DCL4CL8DDL2D.P4L4CL8CCP4DDL4D"πPLAY "P4L8<CDL2E.L8DCL4DL2<GL8>DDL2F.L8EDEDL2CL8DCL2A.L8>C<A"πPLAY "L2G.L8FEFEL4DL8>DCL4CP4CDP8L8<GBL4>CCL8C<BL4BL8BAL4AG"πPLAY "L8GBL4>CCL8C<BL4BL8BAL4AGL8GB>CL4CDL8CL4<BL8>CL4C.L8D"πPLAY "L4<GG.P4L8GB>CCL4<AL8>C<BL4BL8BAAAL4>DCL8CCL4<AL8>C<B"πPLAY "L4BL8BAL4AL8GB>CL4C.L8DCL4<BL8>CL4C.L8D<GL4GG>C<BL8BB"πPLAY "AAL4AGL8GBL4>CCL8C<BL4BL8BAL4AGL8GBL4>CCL8C<BL4BL8BAL4A"πPLAY "GL8GBL4>CCL8C<BL4BL8BAL4AGL8GBL1C"ππREM Ave MariaπPLAY "MLT100L16O1A+.>D.F.<A+.>D.F.<A+.>D.F.<A+.>D.F.A+.D.F.<A+.>D.F.<A+.>"πPLAY "D.E.A.D.A+.>D.<D.F.<F.A+.>D.<F.A.>D+.<F.A.O3C.<A+.<A+.>D.<G.A+.>D.<"πPLAY "G.A+.>D.<G.A+.>D.>C.O1G.>C.<D+.G.>C.>DC<A+.C.A.G.C.A.A+.D.F.<A+.>D."πPLAY "F.<A+.>D.F.>D.<D.F.<A+.>D.F+.<A+.O3C.<A+.A.D.G.>D.<D.>E.D.<D.E.<A+."πPLAY ">D.E.>C+.<C+.G.<A.>C+.A.>C.<D+.F+.<A.>D+.A+.A.>C.D.D+.C.<A.A+.D.G.<"πPLAY "A+.>D.G.<A+.>D.E.>D.<D.>C.O1A.>C.F.<A.>C.A.G.B.>D.F.D.<B.>C.<C.F.<A.>"πPLAY "C.F.<A+.>G.A.A+.A.G.F.C.F.<A.>C.F.<A.>C.F.P64F.C.F.>C.O1A.>D+.<F.A."πPLAY "O3C.P64C.O1A.>B.>C.O1A.O3D.C.O1A+.O3D.<A+.<A+.>D.<F.A+.>D.<F.A+.>A+."πPLAY ">C.O1A.>D+.<F.A.O3C.P64C.<B.>C.D+.D.C.<A+.<A+.>D.<G.A+.>D.<G.A+.>D.A+.<"πPLAY "A+.>D.>C.O1A.>C.<F.A.O3C.D.O1A.O3D.P64D.D+.D.C.D.F.<C.D+.>D+.<C.D+.<G."πPLAY ">C.D+.G.C.D+.>D.O1G.>C.>C.O1G.O3C.<A+.A.A+.>C+.C.<A+.>C.O1A.>C.<F.A.>"πPLAY "C.<F.A.>D+.<F.A.>D+.A+.D.F.<A+.>D.F.<A+.>D.E.A.D.A+.>D.O1A+.>D.<F.A+.>"πPLAY "D.<F.A.>D+.<F.A.O3C.<A+.D.F.<A+.>D.F.>D.<D.F.>F.<D.F.L2>A+P4"ππREM Star Trek TOS ThemeπPLAY "MNT255L1O4B.D.F.<A.P8L2GL8G>C.L2FFL4E.L8EL4C<A>DL2GP8"πPLAY "L4GL1BP4L2CL8CF.L2A+A+L4A.L8AL4FDGL2>CP8L4CL1EP1L2O3G"πPLAY ">F.L4EDC<BL2A+L1A+L2G>G.L4FEDCL2<BL1BL4A+L2A.L4B>C+DE"πPLAY "F+GL2AL1A+.L2<A+.L4>CDD+FGG+L2A+L1BL2<G>F.L4EDC<BL2A+"πPLAY "L1A+L4G+L2G>G.L4FEDCL2<BL1BL4A+L2A.L4B>CDEFEL2G.L4GL2A+."πPLAY "L4AL2GL1CL4D.F.A.L1>C"ππ'I hope these are the type of thing you are looking for. If you want toπ'test out the background command, just add:ππ'PLAY "MB" 'before the song andπ'PLAY "MF" 'after the song.ππ'I have MANY more of these if you are interested. I didn't write them andπ'have absolutely NO idea who did. I had them in an old ZIP file on archiveπ'and it doesn't contain any credits in it.πCharles Godard FLUTE BOOK MUSIC COLLECTION FidoNet QUIK_BAS Echo 07-16-96 (00:05) QB, QBasic, PDS 39 2055 FLUTEMUS.BAS' >Do any of you know how to play QUICKBASIC music in the background of aπ' >program?ππ'I never could figure out how to play more than about 32 notes in theπ'background (the best I can remember). Had to keep looping back everπ'so often to keep it playing in bg... the MB command does it.ππ' >Also, do any of you got any good QUICKBASIC music with the PLAY command,π' >(Like the Happy Birthday thing I saw)ππ'I copied these from a flute book, and played with the tempo, octaves,etc.ππREM ABC SONG:πPLAY "O3 l4ccggaal2g l4ffeel8ddddl2c l4ggffee l2dl8ggl4gffeel2d l4ccggaal2g l4ffee l4dd l2c"ππREM BINGO:π PLAY "mb O3 L8GGDDEEDDGGAAL4BGBBL8>CCL4C<AAL8BBL4BGGL8AAAGF+DEF+L4GG"πREM SWEET BETSY FROM PIKE:π PLAY "T220 O3 L4CCEGGFDDCCL2CL4CCEG>CCC<BGG L2G L4G >CCC <BGEFGA L2G L8CD L4EEE GFD DCCL3C" '1st time thru songπ PLAY "L8CD L4EEE GFD DCC L2C L8CD L4EEE GFD DCC L2C L4C" 'this line is 1st CHORUSπ PLAY "O3 L4CEGGFDDCCL2CL4CCEG>CCC<BGG L2G L4G >CCC <BGEFGA L2G L8CD L4EEE GFD DCCL3C" '2nd time thru songπ PLAY "L8CD L4EEE GFD DCC L2C L8CD L4EEE GFD L4DCCL2C" '2nd time thur CHORUSπREM shortnin' bread :π PLAY "T120 O3 <L4F>L8DDL4CD<L8FF>L4DL2CL4<F>DCL8DD<L8AAL4GFN0 "π PLAY "T180 O4 < F >L8DDL4CD <F> DL2C <L4F >DL8CCL4D <AGF>N0"π PLAY "T200 O5 <L8FF> DD CC L4D <F> DCD L8<FF>DDCC L4D <AGFN0"π PLAY "T250 O5 <L8FF>DDCCL4D<F>DCD L8<FF>DDCCL4D <AGFN0"πREM down at the station:π PLAY "T 180 O3 L4G L8GA L4BB L8AG AB L4GG L8BB B>CDDDDC<B>CD<L2B"π PLAY "O3 L8 GGGAL4BBL8AGABL4GG GG>DD <AB> <L2G"πREM Jingle Bells:π PLAY "T150 O3 L8BBL4BL8BBL4BL8B>D<GAL2B L8>CCCCC<BBBBAABL4A>D<"π PLAY "O3 L8BBL4BL8BBL4BL8B>D<GAL2B L8>CCCCC<BBB>DDC<AL2G"πREM merrily we roll along:π PLAY "T 200 O3 L4BAGABBL2BL4AAL2AL4BBL2BL4BAGABBL2BL4AABAL1G"π PLAY "T 200 O3 L4BAGABBL2BL4AAL2AL4BBL2BL4BAGABBL2BL4AABAL1G"πREM MICHAEL, ROW THE BOAT ASHORE:π PLAY "O3 L4FA MS L2ML>C<L8AL8>CDL2CL4<A>CL1DL2CL4<A>CMS L2MLC<L8A> L4C<AL2GL4FGL2AGF"π PLAY "O3 L4 FA MS L2ML>C<L8AL8>CDL2CL4<A>CL1DL2CL4<A>CMS L2MLC<L8A> L4C<AL2GL4FGL2AGF"πJohn Fischer PLAY MUSICAL HELPER FidoNet QUIK_BAS Echo 07-17-96 (20:51) QB, QBasic, PDS 319 10518 PLAYHELP.BAS' > paid any attention to the PLAY syntax. Now I've been looking aroundπ' > and I find an alarming paucity of available programs written to showπ' > off the PLAY function, so I'm contributing this one as a publicπ' > service: ππ'I agree, and although sound cards are much better, PLAY *IS* a part of QBπ'(either flavor). Here's a hastily written (and I mean HASTY) chuck of codeπ'that anyone is welcome to PLAY with. BASICally, it will give you a veryπ'generic menu and let you input play commands into a buffer (sort of) andπ'then play them back for you, save them, etc.. I have NOT put an editorπ'into it, and probably won't, since I was just wanting to get more familiarπ'with PLAY. One last thing, I forgot that the . (period) after a note DOESπ'make it a dotted note, even though that is NOT in the help section,π'therefore, I did not code for it. IF anyone plays with this and makesπ'something of it, all I ask is for a copy it to poke around in. Theπ'following is original and by posting it here I release it to the publicπ'domain. ππDECLARE FUNCTION Music$ (A$)πCLEARπON ERROR GOTO OoopsπIF COMMAND$ = "" THENπ FileName$ = "MUSIC.SND"π ELSE FileName$ = COMMAND$πEND IFπOPEN FileName$ FOR OUTPUT AS #1πCONST F1 = 59, F2 = 60, F3 = 61, F4 = 62, F10 = 68πNull$ = CHR$(0)πTemp$ = "O3 L4 T120 MN "πL = 4: O = 3: T = 120: T$ = " 7/8"πTopMenu:πCLS : COLOR 11πPRINT , "Input Keys to Play", "F10 = Help/Other Keys"πPRINT : COLOR 15πPRINT , "A - G) Corresponding Note"πPRINT , "+ / -) PREVIOUS Note SHARP or FLAT"πPRINT , "L) Set Length of NEXT Notes (1-64)"πPRINT , "N) Play a Note by it's Number (0-84)"πPRINT , "O) Set Octave of NEXT Notes (0-6)"πPRINT , "P) Pause for n ¼ Notes"πPRINT , "T) Set # of ¼ Notes/Minute (32-255)"πPRINT , "< or > DOWN or UP 1 Octave"πPRINT , "1, 3, 7) Each Note FULL, 3/4, 7/8"πPRINT : COLOR 13πPRINT , "F1) Play Your Tune", "F3) List Your Tune"πPRINT , "F2) Start Over", "F4) PRINT Your Tune"πPRINT : COLOR 12πPRINT , "ESC) Save and End Program"πCOLOR 14πLOCATE 5, 53: PRINT LπLOCATE 7, 53: PRINT OπLOCATE 9, 53: PRINT TπLOCATE 11, 53: PRINT T$πCOLOR 7πGetChoice: CHOICE$ = INKEY$πSELECT CASE UCASE$(CHOICE$)π CASE IS = "/"π CLS : SHELL: GOTO TopMenuπ CASE IS = "*"π CLS : SHELL "LIST": GOTO TopMenuπ CASE IS = "`"π CLS : SHELL "MUSIC.BAT": GOTO TopMenuπ CASE IS = "1"π Temp$ = Music$("ML")π T$ = " Full ML"π GOTO TopMenuπ CASE IS = "3"π Temp$ = Music$("MS")π T$ = " 3/4 MS"π GOTO TopMenuπ CASE IS = "7"π Temp$ = Music$("MN")π T$ = " 7/8 MN"π GOTO TopMenuπ CASE IS = "A"π Temp$ = Music$("A")π CASE IS = "B"π Temp$ = Music$("B")π CASE IS = "C"π Temp$ = Music$("C")π CASE IS = "D"π Temp$ = Music$("D")π CASE IS = "E"π Temp$ = Music$("E")π CASE IS = "F"π Temp$ = Music$("F")π CASE IS = "G"π Temp$ = Music$("G")π CASE IS = "<"π Temp$ = Music$("<")π O = O - 1π IF O < 0 THEN O = 0π IF O > 6 THEN O = 6π GOTO TopMenuπ CASE IS = ","π Temp$ = Music$("<")π O = O - 1π IF O < 0 THEN O = 0π IF O > 6 THEN O = 6π GOTO TopMenuπ CASE IS = ">"π Temp$ = Music$(">")π O = O + 1π IF O < 0 THEN O = 0π IF O > 6 THEN O = 6π GOTO TopMenuπ CASE IS = "."π Temp$ = Music$(">")π O = O + 1π IF O < 0 THEN O = 0π IF O > 6 THEN O = 6π GOTO TopMenuπ CASE IS = "+"π Temp$ = Music$("+")π CASE IS = "-"π Temp$ = Music$("-")π CASE IS = "L"π LOCATE 18, 20: PRINT "Range: 1 - 64"π LOCATE 19, 20: INPUT "Length"; Aπ IF A < 1 OR A > 64 THEN A = 4π L = Aπ Temp$ = Music$("L" + RTRIM$(LTRIM$(STR$(A))))π GOTO TopMenuπ CASE IS = "N"π LOCATE 18, 20: PRINT "Range: 0 - 84"π LOCATE 19, 20: INPUT "Note"; Aπ IF A < 0 OR A > 84 THEN A = 4π Temp$ = Music$("N" + RTRIM$(LTRIM$(STR$(A))))π GOTO TopMenuπ CASE IS = "O"π LOCATE 18, 20: PRINT "Range: 0 - 6"π LOCATE 19, 20: INPUT "Octave"; Aπ IF A < 0 OR A > 6 THEN A = 0π O = Aπ Temp$ = Music$("O" + RTRIM$(LTRIM$(STR$(A))))π GOTO TopMenuπ CASE IS = "P"π LOCATE 18, 20: PRINT "Range: 1 - 64"π LOCATE 19, 20: INPUT "Pause Time"; Aπ IF A < 1 OR A > 64 THEN A = 4π Temp$ = Music$("P" + RTRIM$(LTRIM$(STR$(A))))π GOTO TopMenuπ CASE IS = "T"π LOCATE 18, 20: PRINT "Range: 32 - 255"π LOCATE 19, 20: INPUT "¼ Notes/Minute"; Aπ IF A < 32 OR A > 255 THEN A = 120π T = Aπ Temp$ = Music$("T" + RTRIM$(LTRIM$(STR$(A))))π GOTO TopMenuπ CASE IS = Null$ + CHR$(F1)π IF LEN(Temp$) > 0 THEN PRINT #1, Temp$π Temp$ = "": CLOSE #1π OPEN FileName$ FOR INPUT AS #1π LOCATE 18π DO UNTIL EOF(1)π LINE INPUT #1, X$π PRINT X$π 'PLAY "MB" + X$π PLAY X$π LOOPπ CLOSE #1π OPEN FileName$ FOR APPEND AS #1π COLOR 15π PRINT : PRINT "Press the SPACEBAR to resume"π COLOR 7π SLEEPπ DO UNTIL INKEY$ = "": LOOPπ GOTO TopMenuπ CASE IS = Null$ + CHR$(F2)π Temp$ = "O3 L4 T120 MN "π CLOSE #1π OPEN FileName$ FOR OUTPUT AS #1π LOCATE 18, 20π COLOR 15π PRINT "All Music Cleared"π COLOR 7π SLEEP 1π L = 4: O = 3: T = 120: T$ = " 7/8"π GOTO TopMenuπ CASE IS = Null$ + CHR$(F3)π IF LEN(Temp$) > 0 THEN PRINT #1, Temp$π Temp$ = ""π CLOSE #1π OPEN FileName$ FOR INPUT AS #1π LOCATE 18π DO UNTIL EOF(1)π LINE INPUT #1, X$π PRINT X$π LOOPπ CLOSE #1π OPEN FileName$ FOR APPEND AS #1π COLOR 15π PRINT : PRINT "Press the SPACEBAR to resume"π COLOR 7π SLEEPπ DO UNTIL INKEY$ = "": LOOPπ GOTO TopMenuπ CASE IS = Null$ + CHR$(F4)π IF LEN(Temp$) > 0 THEN PRINT #1, Temp$π Temp$ = ""π CLOSE #1π OPEN FileName$ FOR INPUT AS #1π OPEN "PRN" FOR OUTPUT AS #2π DOπ LINE INPUT #1, X$π PRINT #2, X$π LOOP UNTIL EOF(1)π PRINT #2, ""π CLOSE #2π CLOSE #1π OPEN FileName$ FOR APPEND AS #1π GOTO TopMenuπ CASE IS = Null$ + CHR$(F10)π CLSπ COLOR 14π PRINTπ PRINT , "T20 = 1/2 time", "T40 = 2/2 time"π PRINT , "T80 = 2/4 time", "T120 = 3/4 time"π PRINT , "T160 = 4/4 time", "T240 = 6/8 time"π PRINTπ PRINT , "L1 = Whole Note", "L2 = Half Note"π PRINT , "L4 = Quarter Note", "L8 = Eighth Note"π PRINT , "L16 = Sixteenth Note", "L32 = Thirty-Second Note"π PRINTπ PRINT , "Octave: Higher the number, higher the pitch"π PRINTπ COLOR 3π PRINT , "Other MAIN MENU Commands Available"π PRINT , "` Run file MUSIC.BAT if it exists"π PRINT , "~ create MUSIC_QB.BAS (PLAYable)"π PRINT , "* Run LIST"π PRINT , "/ DOS Shell"π COLOR 15π PRINT : PRINT , "Press the SPACEBAR to continue"π COLOR 7π SLEEPπ DO UNTIL INKEY$ = "": LOOPπ CLSπ COLOR 14π PRINT , "Central Octave Chart"π COLOR 2π PRINTπ PRINT , " B"π PRINT , " ── A ──"π PRINT , " G"π PRINT , "──────────────────── F ─────── Octave #4"π PRINT , " E"π PRINT , "──────────────────── D ───────"π PRINT , " C"π COLOR 10π PRINT , "─────────────── B ────────────"π PRINT , " A"π PRINT , "─────────────── G ────────────"π PRINT , " F Octave #3"π PRINT , "─────────────── E ──────────── (Default)"π PRINT , " D"π PRINT , " ── C ──"π COLOR 15π PRINT : PRINT , "You MUST shift octaves to use the entire scale"π PRINT : PRINT , "Press the SPACEBAR to continue"π COLOR 7π SLEEPπ DO UNTIL INKEY$ = "": LOOPπ GOTO TopMenuπ CASE IS = CHR$(27)π PRINT #1, Temp$π CLOSE #1π LOCATE 22π ENDπ CASE IS = "~"π PRINT #1, Temp$: Temp$ = ""π CLOSE #1π OPEN FileName$ FOR INPUT AS #1π OPEN "MUSIC_QB.BAS" FOR OUTPUT AS #2π PRINT #2, "CLS : CLEAR"π PRINT #2, "PLAY " + CHR$(34) + "MB" + CHR$(34)π PRINT #2, "'The Above line switches to BACKGROUND playing"π DO UNTIL EOF(1)π LINE INPUT #1, Bas$π IF Bas$ <> "" THENπ Bas1$ = "PRINT " + CHR$(34) + Bas$ + CHR$(34)π Bas2$ = "PLAY " + CHR$(34) + Bas$ + CHR$(34)π PRINT #2, Bas1$π PRINT #2, Bas2$π END IFπ LOOPπ PRINT #2, "PLAY " + CHR$(34) + "MF" + CHR$(34)π PRINT #2, "'The Above line switches back to FOREGROUND playing"π PRINT #2, "END"π CLOSE #2π CLOSE #1π OPEN FileName$ FOR APPEND AS #1π CASE ELSEπ GOTO GetChoiceπEND SELECTπGOTO GetChoiceπLOCATE 22πENDπOoops:πCOLOR 7πCLSπCLOSEπOPEN "MUSIC.ERR" FOR APPEND AS #1πPRINT #1, TIME$, DATE$, ERRπCLOSE #1πPRINT : PRINT "An error has occured: #"; ERRπPRINT "See file MUSIC.ERR for QB4.5 error number"πENDππFUNCTION Music$ (Add$)πSHARED Temp$πKill$ = "ABCDEFG"πIF INSTR(Kill$, Add$) > 0 THENπ Temp$ = Temp$ + Add$π ELSE Temp$ = Temp$ + Add$π IF LEN(Temp$) >= 50 THEN PRINT #1, Temp$: Temp$ = ""πEND IFπMusic$ = Temp$πEND FUNCTIONπLloyd Chang ADLIB SOUND EFFECTS FidoNet QUIK_BAS Echo 08-05-96 (18:39) QB, QBasic, PDS 358 12335 ADLIBFX.BAS ' > Anyway, I really need to get adlib sound into my Qb4.5 programs. ππ'I hope ADLIB.BAS will help. It's included at the bottom of thisπ'message.ππ'As to making your own sound effects (in non-mathematical form),π'I have not yet figured out how to do that. Tim Truman'sπ'defender game comes with six sound effects. Perhaps you wantπ'to examine those first.ππ'Just in case you want to contact Tim Truman, his AOL accountπ'is "Tim Truman" and his Compuserve address is "74734,2203"ππ'I have not contacted him yet but the addresses should stillπ'work since his Defender game was written in 1995 and revisedπ'in 1996.ππ'I believe you can also reach him via the internet through hisπ'Compuserve address (but I don't really know how Compuserveπ'converts its user addresses into Internet addresses).ππ'------------------------------ CUT HERE ------------------------------ππ'ADLIB.BASπ'Written by Lloyd Changππ'ADLIB.BAS is meant to provideπ'a skeleton to the use of an adlibπ'sound effects in QuickBASICππ'.---------.π'| NOTICE: |π'`---------'π'The functions, sub-routines, and adlib detectionπ'are stripped from Defender, a QuickBASIC gameπ'written by Tim Truman (based on the Defenderπ'game on the Atari 2600).ππDECLARE FUNCTION adlib () ' detects presence of adlibπDECLARE SUB WriteReg (reg, value) ' write to adlibs registersπDECLARE SUB adlibfx (num) ' plays the soundsππDEFINT A-ZππIF adlib THENπ adlibsound = TRUEπ PRINT "Adlib detected"π SLEEP (1)πEND IFππadlibfx (0)πSLEEP 1πadlibfx (1)πSLEEP 2πadlibfx (0)πSLEEP 3πadlibfx (1)πSLEEP 4πadlibfx (0)πSLEEP 5πadlibfx (1)πSLEEP 6ππDEFSNG A-ZπFUNCTION adlibππ ' Detects an AdLib-compatible card.π ' Returns 1 (true) if detected and 0 (false) if not.π π π CALL WriteReg(&H4, &H60) ' Resets both Timersπ CALL WriteReg(&H4, &H80) ' Enables Interruptsπ b = INP(&H388) ' Store the resultπ CALL WriteReg(&H2, &HFF) ' Write FFh to register 2 (Timer 1)π CALL WriteReg(&H4, &H21) ' Start Timer 1ππ FOR x = 0 TO 130 ' Delay for 80 Microsecondsπ a = INP(&H388)π NEXT xππ c = INP(&H388) ' Store the resultπ CALL WriteReg(&H4, &H60) ' Reset Timersπ CALL WriteReg(&H4, &H80) ' Reset Interrruptsπ Success = 0π IF (b AND &HE0) = &H0 THEN ' Test resultπ IF (c AND &HE0) = &HC0 THEN ' Test Resultπ Success = 1π FOR q = 1 TO &HF5 ' clear registersπ CALL WriteReg(q, 0)π NEXT qπ END IFπ END IFπ adlib = SuccessπππEND FUNCTIONππSUB adlibfx (num)ππ SELECT CASE (num)ππ CASE (0) ' mutant explodingππ π WriteReg &HB0, &H0π numberl = 60π numberh = 1π block = 0π ' Modulatorπ CALL WriteReg(&H20, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H40, &H0) ' Attenuation Level - 0 to 3Fπ CALL WriteReg(&H60, &HA5) ' Attack: (High byte) Decay: (Low byte)π CALL WriteReg(&H80, &H0) ' Sustain: (High byte) Release: (Low byte)π CALL WriteReg(&HE0, &HF0) ' Waveform select 0 to 3π ' Carrierπ CALL WriteReg(&H23, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H43, &H0) ' Attenuation level - 0 to 3Fπ CALL WriteReg(&H63, &HA6) ' Attack: (High byte) Decay:(low byte)π CALL WriteReg(&H83, &HAA) ' Sustain: (High Byte) Release:(low byte)π CALL WriteReg(&HE1, &HF0) ' Waveform select 0 to 3ππ keyon% = &H20ππ Byte = keyon% + (block * 4) + numberh%ππ CALL WriteReg(&HA0, numberl) ' F-Number(L) 0 to 255π CALL WriteReg(&HB0, Byte) ' Sound voice ,Set block ,Set F-Number(H)πππ CASE 1 'hero firingππ WriteReg &HB1, &H0ππ numberl = 230π numberh = 1π block = 1π ' Modulatorπ CALL WriteReg(&H21, &H10) ' Multiple - 0 to Fπ CALL WriteReg(&H41, &H0) ' Attenuation Level - 0 to 3Fπ CALL WriteReg(&H61, &H66) ' Attack: (High byte) Decay: (Low byte)π CALL WriteReg(&H81, &HF6) ' Sustain: (High byte) Release: (Low byte)π CALL WriteReg(&HE1, &HF2) ' Waveform select 0 to 3π ' Carrierπ CALL WriteReg(&H24, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H44, &H6) ' Attenuation level - 0 to 3Fπ CALL WriteReg(&H64, &H63) ' Attack: (High byte) Decay:(low byte)π CALL WriteReg(&H84, &HF8) ' Sustain: (High Byte) Release:(low byte)π CALL WriteReg(&HE4, &HF0) ' Waveform select 0 to 3ππ keyon = &H20ππ Byte = keyon + (block * 4) + (numberh)ππ CALL WriteReg(&HC1, 0) ' conectionπ CALL WriteReg(&HC1, 0) ' conectionπ CALL WriteReg(&HA1, numberl) ' F-Number(L) 0 to 255π CALL WriteReg(&HB1, Byte) ' Sound voice ,Set block ,Set F-Number(H)ππ ' WriteReg &HB1, &H0 ' stop noiseππ ' numberl = 10π ' numberh = 0π ' block = 7π ' Modulatorπ ' CALL WriteReg(&H21, &H3) ' Multiple - 0 to Fπ ' CALL WriteReg(&H41, &H0) ' Attenuation Level - 0 to 3Fπ ' CALL WriteReg(&H61, &H99) ' Attack: (High byte) Decay: (Low byte)π ' CALL WriteReg(&H81, &HFF) ' Sustain: (High byte) Release: (Low byte)π ' CALL WriteReg(&HE1, &HF0) ' Waveform select 0 to 3π ' Carrierπ ' CALL WriteReg(&H24, &H1) ' Multiple - 0 to Fπ ' CALL WriteReg(&H44, &H0) ' Attenuation level - 0 to 3Fπ ' CALL WriteReg(&H64, &HAD) ' Attack: (High byte) Decay:(low byte)π ' CALL WriteReg(&H84, &H55) ' Sustain: (High Byte) Release:(low byte)π ' CALL WriteReg(&HE4, &HF0) ' Waveform select 0 to 3ππ ' keyon% = &H20ππ ' Byte = keyon% + (block * 4) + numberhππ ' CALL WriteReg(&HA1, numberl) ' F-Number(L) 0 to 255π ' CALL WriteReg(&HB1, Byte) ' Sound voice ,Set block ,Set F-Number(H)ππππ CASE 2 ' colonist pick up warningππ WriteReg &HB2, &H0 ' stop noiseππ numberl = 255π numberh = 3π block = 2π ' Modulatorπ CALL WriteReg(&H22, &H3) ' Multiple - 0 to Fπ CALL WriteReg(&H42, &H0) ' Attenuation Level - 0 to 3Fπ CALL WriteReg(&H62, &H5F) ' Attack: (High byte) Decay: (Low byte)π CALL WriteReg(&H82, &HFF) ' Sustain: (High byte) Release: (Low byte)π CALL WriteReg(&HE2, &HF0) ' Waveform select 0 to 3π ' Carrierπ CALL WriteReg(&H25, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H45, &H9) ' Attenuation level - 0 to 3Fπ CALL WriteReg(&H65, &H5F) ' Attack: (High byte) Decay:(low byte)π CALL WriteReg(&H85, &HFF) ' Sustain: (High Byte) Release:(low byte)π CALL WriteReg(&HE5, &HF0) ' Waveform select 0 to 3ππ keyon% = &H20ππ Byte = keyon% + (block * 4) + numberhππ CALL WriteReg(&HA2, numberl) ' F-Number(L) 0 to 255π CALL WriteReg(&HB2, Byte) ' Sound voice ,Set block ,Set F-Number(H)πππ CASE 3 ' mutant convertedπ WriteReg &HB3, &H0ππ numberl = 10π numberh = 0π block = 5π ' Modulatorπ CALL WriteReg(&H28, &H5) ' Multiple - 0 to Fπ CALL WriteReg(&H48, &H0) ' Attenuation Level - 0 to 3Fπ CALL WriteReg(&H68, &H99) ' Attack: (High byte) Decay: (Low byte)π CALL WriteReg(&H88, &HFF) ' Sustain: (High byte) Release: (Low byte)π CALL WriteReg(&HE8, &HF0) ' Waveform select 0 to 3π ' Carrierπ CALL WriteReg(&H2B, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H4B, &H0) ' Attenuation level - 0 to 3Fπ CALL WriteReg(&H6B, &HAD) ' Attack: (High byte) Decay:(low byte)π CALL WriteReg(&H8B, &H55) ' Sustain: (High Byte) Release:(low byte)π CALL WriteReg(&HEB, &HF0) ' Waveform select 0 to 3ππ keyon% = &H20π π Byte = keyon% + (block * 4) + numberhππ CALL WriteReg(&HA3, numberl) ' F-Number(L) 0 to 255π CALL WriteReg(&HB3, Byte) ' Sound voice ,Set block ,Set F-Number(H)ππ CASE 4 ' mutant firingππ WriteReg &HB4, &H0 ' stop noiseππ numberl = 10π numberh = 0π block = 1π ' Modulatorπ CALL WriteReg(&H29, &H5) ' Multiple - 0 to Fπ CALL WriteReg(&H49, &H0) ' Attenuation Level - 0 to 3Fπ CALL WriteReg(&H69, &H87) ' Attack: (High byte) Decay: (Low byte)π CALL WriteReg(&H89, &HFF) ' Sustain: (High byte) Release: (Low byte)π CALL WriteReg(&HE9, &HF0) ' Waveform select 0 to 3π ' Carrierπ CALL WriteReg(&H2C, &H1) ' Multiple - 0 to Fπ CALL WriteReg(&H4C, &H9) ' Attenuation level - 0 to 3Fπ CALL WriteReg(&H6C, &HA5) ' Attack: (High byte) Decay:(low byte)π CALL WriteReg(&H8C, &H55) ' Sustain: (High Byte) Release:(low byte)π CALL WriteReg(&HEC, &HF0) ' Waveform select 0 to 3ππ keyon% = &H20ππ Byte = keyon% + (block * 4) + numberhππ CALL WriteReg(&HA4, numberl) ' F-Number(L) 0 to 255π CALL WriteReg(&HB4, Byte) ' Sound voice ,Set block ,Set F-Number(H)π π CASE 5ππ 'PRINT " bomer noise"π WriteReg &HB5, &H0 ' stop noiseππ numberl = 60π numberh = 1π block = 2π ' Modulatorπ CALL WriteReg(&H2A, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H4A, &H0) ' Attenuation Level - 0 to 3Fπ CALL WriteReg(&H6A, &H55) ' Attack: (High byte) Decay: (Low byte)π CALL WriteReg(&H8A, &HAA) ' Sustain: (High byte) Release: (Low byte)π CALL WriteReg(&HEA, &HF3) ' Waveform select 0 to 3π ' Carrierπ CALL WriteReg(&H2D, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H4D, &H0) ' Attenuation level - 0 to 3Fπ CALL WriteReg(&H6D, &HFF) ' Attack: (High byte) Decay:(low byte)π CALL WriteReg(&H8D, &HAA) ' Sustain: (High Byte) Release:(low byte)π CALL WriteReg(&HED, &HF3) ' Waveform select 0 to 3πππ CALL WriteReg(&HC5, 1) ' conectionππ keyon% = &H20ππ Byte = keyon% + (block * 4) + numberhππ CALL WriteReg(&HA5, numberl) ' F-Number(L) 0 to 255π CALL WriteReg(&HB5, Byte) ' Sound voice ,Set block ,Set F-Number(H)πππ CASE 6ππ WriteReg &HB4, &H0π numberl = 130π numberh = 0π block = 0π ' Modulatorπ CALL WriteReg(&H29, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H49, &H0) ' Attenuation Level - 0 to 3Fπ CALL WriteReg(&H69, &HA5) ' Attack: (High byte) Decay: (Low byte)π CALL WriteReg(&H89, &H0) ' Sustain: (High byte) Release: (Low byte)π CALL WriteReg(&HE9, &HF0) ' Waveform select 0 to 3π ' Carrierπ CALL WriteReg(&H2C, &H0) ' Multiple - 0 to Fπ CALL WriteReg(&H4C, &H0) ' Attenuation level - 0 to 3Fπ CALL WriteReg(&H6C, &HA6) ' Attack: (High byte) Decay:(low byte)π CALL WriteReg(&H8C, &H55) ' Sustain: (High Byte) Release:(low byte)π CALL WriteReg(&HEC, &HF0) ' Waveform select 0 to 3ππ keyon% = &H20ππ Byte = keyon% + (block * 4) + numberh%ππ CALL WriteReg(&HA4, numberl) ' F-Number(L) 0 to 255π CALL WriteReg(&HB4, Byte) ' Sound voice ,Set block ,Set F-Number(H)ππππ END SELECTππEND SUBππSUB WriteReg (reg, value)ππ' Writes to AdLib's registers the delays required when writing to theseπ' ports are present.π'π' Reg is the register to write to. Value is the data to send.πππOUT &H388, reg ' 388h = Register/Status portπ ' Tells the SB what register we want to write toππ ' Calling the register port 6 times creates anπ ' accurate delay of 3.3ms. This delay is requiredπFOR x = 0 TO 5 ' after writing to the register port.π a = INP(&H388)πNEXT xππOUT &H389, value ' 389h = data portπ ' send data that corrisponds with the requested register.ππ ' Calling the data port 35 times creates anπ ' accurate delay of 23ms. This delay is required.πFOR x = 0 TO 34 ' after writing to the data port.π a = INP(&H388)πNEXT xπππEND SUBπborg953@aol.com PLAY ADLIB comp.lang.basic.misc 08-04-96 (22:16) QB, QBasic, PDS 158 5401 PADLIB.BAS 'You say you wanted SoundBlaser code? I've written a SUB that works withπ'an AdLib-compatible speaker. I think a SoundBlaster works too (at least,π'mine does). It is very easy to use. It uses the same command string thatπ'the PLAY command does. The only difference is that at the top of yourπ'program you have to do aππCALL PlayAdLib("{INIT}")ππ'to set the variables. Here's the code:ππSUB PlayAdLib (comand$)π STATIC tempo, length, music, octaveππ IF comand$ = "{INIT}" THENπ tempo = 120π length = 4π music = 7 / 8π octave = 4π EXIT SUBπ END IFππ comand$ = UCASE$(comand$)π FOR i% = 0 TO 224π WriteReg i%, 0 'Clear all registersπ NEXT i%π WriteReg &H20, &H1 'Plays carrier note at specified octave ch. 1π WriteReg &H23, &H1 'Plays modulator note at specified octave ch. 1π WriteReg &H40, &H1F 'Set carrier total level to softest ch. 1π WriteReg &H43, &H0 'Set modulator level to loudest ch. 1π WriteReg &H60, &HE4 'Set carrier attack and decay ch. 1π WriteReg &H63, &HE4 'Set modulator attack and decay ch. 1π WriteReg &H80, &H9D 'Set carrier sustain and release ch. 1π WriteReg &H83, &H9D 'Set modulator sustain and release ch. 1π π c% = 1π max% = LEN(comand$)π WHILE c% <= max%π x$ = MID$(comand$, c%, 1): c% = c% + 1 'extract subcommandπ IF INSTR("ABCDEFG", x$) <> 0 AND (c% <> max% AND INSTR("+#-", MID$(comand$, c%, 1))) THENπ x$ = x$ + MID$(comand$, c%, 1): c% = c% + 1π IF RIGHT$(x$, 1) = "+" THEN x$ = LEFT$(x$, 1) + "#"π IF x$ = "D-" THEN x$ = "C#"π IF x$ = "E-" THEN x$ = "D#"π IF x$ = "G-" THEN x$ = "F#" 'convert all flats into equivalent sharpsπ IF x$ = "A-" THEN x$ = "G#"π IF x$ = "B-" THEN x$ = "A#"π ELSEIF x$ = "O" THENπ adj% = VAL(MID$(comand$, c%, 1)): c% = c% + 1π IF adj% >= 0 AND adj% <= 6 THEN octave = adj%π ELSEIF x$ = "<" AND octave > 0 THENπ octave = octave - 1π ELSEIF x$ = ">" AND octave < 6 THENπ octave = octave + 1π ELSEIF x$ = "L" THENπ num$ = ""π WHILE INSTR("0123456789", MID$(comand$, c%, 1))π num$ = num$ + MID$(comand$, c%, 1): c% = c% + 1π WENDπ IF VAL(LTRIM$(num$)) >= 1 AND VAL(LTRIM$(num$)) <= 64 THEN length = VAL(LTRIM$(num$))π ELSEIF x$ = "P" THENπ dotfac = 1π num$ = ""π WHILE INSTR("0123456789", MID$(comand$, c%, 1))π num$ = num$ + MID$(comand$, c%, 1): c% = c% + 1π WENDπ WHILE MID$(comand$, c%, 1) = "."π dotfac = dotfac * 1.5: c% = c% + 1π WENDπ IF VAL(num$) >= 1 AND VAL(num$) <= 64 THENπ start! = TIMERπ ender! = start! + (((1 / VAL(num$)) * dotfac) * ((tempo / 120) * 2) * music)π DOπ LOOP UNTIL TIMER >= ender! 'start! + (1 / VAL(num$))π END IFπ ELSEIF x$ = "M" THENπ next$ = MID$(comand$, c%, 1): c% = c% + 1π x$ = x$ + next$π IF x$ = "MN" THEN music = 7 / 8π IF x$ = "MS" THEN music = 3 / 4π IF x$ = "ML" THEN music = 1ππ END IFπ IF INSTR("ABCDEFG", LEFT$(x$, 1)) THENπ dotfac = 1π WHILE MID$(comand$, c%, 1) = "."π dotfac = dotfac * 1.5: c% = c% + 1π WENDπ SELECT CASE x$π CASE "C#"π WriteReg &HA0, &H6B 'Set note numberπ WriteReg &HB0, &H21 + 4 * octave 'Set octave and turn on voiceπ CASE "D"π WriteReg &HA0, &H81π WriteReg &HB0, &H21 + 4 * octaveπ CASE "D#"π WriteReg &HA0, &H98π WriteReg &HB0, &H21 + 4 * octaveπ CASE "E"π WriteReg &HA0, &HB0π WriteReg &HB0, &H21 + 4 * octaveπ CASE "F"π WriteReg &HA0, &HCAπ WriteReg &HB0, &H21 + 4 * octaveπ CASE "F#"π WriteReg &HA0, &HE5π WriteReg &HB0, &H21 + 4 * octaveπ CASE "G"π WriteReg &HA0, &H2π WriteReg &HB0, &H22 + 4 * octaveπ CASE "G#"π WriteReg &HA0, &H20π WriteReg &HB0, &H22 + 4 * octaveπ CASE "A"π WriteReg &HA0, &H41π WriteReg &HB0, &H22 + 4 * octaveπ CASE "A#"π WriteReg &HA0, &H63π WriteReg &HB0, &H22 + 4 * octaveπ CASE "B"π WriteReg &HA0, &H87π WriteReg &HB0, &H22 + 4 * octaveπ CASE "C"π WriteReg &HA0, &HAEπ WriteReg &HB0, &H22 + 4 * (octave - 1)π END SELECTπ start! = TIMERπ ender! = start! + (((1 / length) * dotfac) * ((tempo / 120) * 2) * music)π DOπ LOOP UNTIL TIMER >= ender! '(start! + (1 / length))π WriteReg &HB0, 0π END IFπ WENDπEND SUBππSUB WriteReg (reg AS INTEGER, value AS INTEGER)π '&H is QBASIC hexadecimal prefixπ OUT &H388, reg '&H388 is AdLib register/status portπ 'tells what register to write toπ π FOR c% = 0 TO 5 'reading hardware port 6 times creates manditory 3.3 msπ a% = INP(&H388) 'delayπ NEXT c%ππ OUT &H389, value '&H389 is AdLib data portπ 'sends data to the register specified aboveπ π FOR c% = 0 TO 34 'reading reg/stat port 35 times creates manditoryπ a% = INP(&H388) '23 ms delayπ NEXT c%πEND SUBππ'(The WriteReg SUB is needed for PlayAdLib to work.)ππ'I have a few other SUBs on my WWW site. The address is in my signature.π'Glad I could help.ππ'- Borg953@aol.comπ' http://home.aol.com/Borg953πTony Cave BOTTLES OF BEER ON THE WALL FidoNet QUIK_BAS Echo 08-13-96 (20:58) QB, QBasic, PDS 25 786 BEER.BAS 'Here's something for your computer to do when it gets bored.ππCLSπsong$ = "l8T255<<n25n25n25p8n20n20n20p8n25n25n25n25p8n24n25n26"πsong$ = song$ + "n27n27n27p8n22n22n22n27p8n27n25p8n24p8n22p8"πsong$ = song$ + "n24p8n24p8n24p8p8p8n24n24n24n24p8p8p8p8n20n20n20p8"πsong$ = song$ + "n22n22n24p8n25n25n25n25"πup$ = "p8n20n22n24"πDOπFOR x = 99 TO 1 STEP -1πCLSπLOCATE RND * 22 + 1, 1πPRINT x; "bottles of beer on the wall,"; x; "bottles of beer."πPRINT " Take one down; pass it around. ";πIF x - 1 <> 0 THEN PRINT x - 1; ELSE PRINT " No ";πPRINT "bottles of beer on the wall."πPLAY song$πIF x - 1 <> 0 THEN PLAY up$πa$ = INKEY$: IF a$ <> "" THEN SYSTEMπNEXTπCLS : LOCATE 1, 1πPRINT "One more time"πSLEEP 2&: m$ = INKEY$πIF m$ <> "" THEN DO: LOOP UNTIL m$ <> ""πLOOPπKurt Eckhardt SOUND BLASTER PIANO king@shadow.net 08-20-96 (00:00) QB, QBasic, PDS 332 11389 SBPIANO.BAS 'Coded by Kurt Eckhardt 08/20/96π'The graphics are sketchy, but this program was designed more for exampleπ'that anything else. Try Decay rates of 0-5, they sound best.ππ'I have a generic sound card and the program seems to work fine.π'However, tested on a friends computer who has a true SBpro, produced mixedπ'results (actually it sounded like crap). Sorry if it doesn't work on yourπ'Cpu, but it is Version 1.0ππDEFINT A-ZπDECLARE SUB legal ()πDECLARE SUB info ()πDECLARE SUB pressakey ()πDECLARE SUB Menu ()πDECLARE SUB SBDrum (num%)πDECLARE SUB SBPlay (channel%, n$, Octa%)πDECLARE SUB WriteReg (Reg%, value%)πDECLARE SUB InitCard ()πDECLARE SUB Scale ()πDECLARE SUB pause (secs!)πDECLARE SUB center (text$, row!)πDECLARE FUNCTION offset1% (channel%)πDECLARE FUNCTION offset2% (channel%)πDECLARE FUNCTION DetectCard% ()πDECLARE FUNCTION note% (n$)πCONST StatusP = &H388 'Status portπCONST DataP = &H389 'Data portπCONST TRUE = 1πDIM SHARED tst, vstπDIM SHARED dcayππCLS : CALL infoπCALL legal: CLSπIF DetectCard = TRUE THENπ PRINT "We have a soundcard!"πELSEπ PRINT "Go buy yourself a soundcard!"π SYSTEM: ENDπEND IFπPRINT "Initalizing Card...": InitCardπPRINT "Ok"πPRINT "Press any key to continue": pressakeyππCALL Menuππ'Make sure all registers are cleared before closingπCALL WriteReg(&HB0, 0)πCALL InitCardπSYSTEM: ENDππDEFSNG A-ZπSUB center (text$, row)πtext$ = RTRIM$(text$)πLOCATE row, 40 - LEN(text$) / 2πPRINT text$πEND SUBππDEFINT A-ZπFUNCTION DetectCardπCALL WriteReg(&H4, &H60) 'Reset both timersπCALL WriteReg(&H4, &H80)πstat1 = INP(&H388) 'Store resultπCALL WriteReg(&H2, &HFF)πCALL WriteReg(&H4, &H21)πpause .08 'Wait 80msecsπstat2 = INP(&H388) 'Store resultπCALL WriteReg(&H4, &H60) 'Reset both timersπCALL WriteReg(&H4, &H80)πIF (stat1 AND &HE0) = &H0 THENπ IF (stat2 AND &HE0) = &HC0 THENπ found = TRUEπ END IFπEND IFπDetectCard = foundπEND FUNCTIONππSUB infoπCLSπPRINT "Coded and Designed by Kurt Eckhardt"πPRINT "Copyrite 1996 All Rights Reserved"πPRINT "V1.0 Completed on 8/20/96"πPRINT "Channels 1 through 3 appear to be working correctly as do the drums (I think)"πPRINT "But channels 4-9 only produce muted/distorted sounds, if any at all."πPRINT "Vibrato and Tremolo are operational, but the effect cannot be heard"πPRINT "If the decay is set too short."πPRINT "Sorry about the sharps, they work, but no keyboard interface yet."πPRINT "You'll have to wait until I put in mouse support."πPRINT "If you find any info in this program useful for your own programming endevours,"πPRINTπPRINT "I would greatly appreciate you sending me 1$ so I can make my way through"πPRINT "college. I bet you can look around right now and find that within 10 feet"πPRINT "of yourself- if not, you are as broke as I am."πPRINT "Any comments or questions, send me some email at <king@shadow.net>"πPRINT "Here's the address for that measly buck: "πPRINTπPRINT "Kurt Eckhardt"πPRINT "1820 West Oak Knoll Circle"πPRINT "Ft. Lauderdale FL 33324"πPRINTπPRINT "Thanks!"πpressakeyπEND SUBππSUB InitCardπ'Set all 244 registers to 0 to initalizeπFOR lp = 1 TO 2πFOR Regis = 1 TO &HF5πCALL WriteReg(Regis, 0)πNEXT RegisπNEXT lpππ'Set variablesπdcay = 5: vst = 0: tst = 0πEND SUBππSUB legalπCLSπcenter "Legal Stuff", 1πPRINTπPRINT "1. This program may be freely distributed so long as no changes have been made."πPRINT "2. This program, or any part of it, may not be used in another program"πPRINT " without my written consent."πPRINT "3. I take no responsibilty for any adverse affects that may be caused by"πPRINT " usage of this program upon your machine."π πcenter "By possessing this program you agree with these terms.", 10πpressakeyπEND SUBππSUB MenuπSCREEN 12: CLSππCOLOR 2: center "One Really Bad Music Machine", 1πcenter "By: Kurt Eckhardt V1.0", 2: COLOR 15πππLOCATE 5, 1: COLOR 11: PRINT "6: "; : COLOR 3: PRINT "Tremolo: OFF"πLOCATE 6, 1: COLOR 11: PRINT "7: "; : COLOR 3: PRINT "Vibrato: OFF"πLOCATE 5, 66: COLOR 11: PRINT "8: "; : COLOR 3: PRINT "Decay: "; HEX$(dcay)πLOCATE 15, 8: COLOR 11: PRINT "0: "; : COLOR 9: PRINT "Quit"πLOCATE 16, 8: COLOR 11: PRINT "1: "; : COLOR 9: PRINT "Hi Hat"πLOCATE 17, 8: COLOR 11: PRINT "2: "; : COLOR 9: PRINT "Symbol"πLOCATE 18, 8: COLOR 11: PRINT "3: "; : COLOR 9: PRINT "Tom Drum"πLOCATE 19, 8: COLOR 11: PRINT "4: "; : COLOR 9: PRINT "Snare Drum"πLOCATE 20, 8: COLOR 11: PRINT "5: "; : COLOR 9: PRINT "Bass Drum"ππCOLOR 11πLOCATE 26, 8: PRINT "C D E F G A B"πLOCATE 26, 30: PRINT "C D E F G A B"πLOCATE 26, 52: PRINT "C D E F G A B C"πLOCATE 22, 8: PRINT "C# D# F# G# A#"πLOCATE 22, 30: PRINT "C# D# F# G# A#"πLOCATE 22, 52: PRINT "C# D# F# G# A# C#"ππCOLOR 9πFOR x = 50 TO 575 STEP 25πLINE (x, 330)-(x + 25, 420), , BπNEXT xπLINE (50, 365)-(600, 365)ππDOπ key$ = UCASE$(INKEY$)π SELECT CASE key$π CASE "Z": CALL SBPlay(1, "C", 4): xpos = 8: char$ = "C"π CASE "X": CALL SBPlay(1, "D", 4): xpos = 11: char$ = "D"π CASE "C": CALL SBPlay(1, "E", 4): xpos = 14: char$ = "E"π CASE "V": CALL SBPlay(1, "F", 4): xpos = 18: char$ = "F"π CASE "B": CALL SBPlay(1, "G", 4): xpos = 21: char$ = "G"π CASE "N": CALL SBPlay(1, "A", 4): xpos = 24: char$ = "A"π CASE "M": CALL SBPlay(1, "B", 4): xpos = 27: char$ = "B"π CASE "A": CALL SBPlay(2, "C", 5): xpos = 30: char$ = "C"π CASE "S": CALL SBPlay(2, "D", 5): xpos = 33: char$ = "D"π CASE "D": CALL SBPlay(2, "E", 5): xpos = 36: char$ = "E"π CASE "F": CALL SBPlay(2, "F", 5): xpos = 40: char$ = "F"π CASE "G": CALL SBPlay(2, "G", 5): xpos = 43: char$ = "G"π CASE "H": CALL SBPlay(2, "A", 5): xpos = 46: char$ = "A"π CASE "J": CALL SBPlay(2, "B", 5): xpos = 49: char$ = "B"π CASE "Q": CALL SBPlay(3, "C", 6): xpos = 52: char$ = "C"π CASE "W": CALL SBPlay(3, "D", 6): xpos = 55: char$ = "D"π CASE "E": CALL SBPlay(3, "E", 6): xpos = 58: char$ = "E"π CASE "R": CALL SBPlay(3, "F", 6): xpos = 62: char$ = "F"π CASE "T": CALL SBPlay(3, "G", 6): xpos = 65: char$ = "G"π CASE "Y": CALL SBPlay(3, "A", 6): xpos = 68: char$ = "A"π CASE "U": CALL SBPlay(3, "B", 6): xpos = 71: char$ = "B"π CASE "I": CALL SBPlay(3, "C", 7): xpos = 74: char$ = "C"π CASE "1": CALL SBDrum(1)π CASE "2": CALL SBDrum(2)π CASE "3": CALL SBDrum(3)π CASE "4": CALL SBDrum(4)π CASE "5": CALL SBDrum(5)π CASE "6": tst = tst + 1: IF tst > 1 THEN tst = 0π CASE "7": vst = vst + 1: IF vst > 1 THEN vst = 0π CASE "8": dcay = dcay + 1: IF dcay > &HF THEN dcay = 0π CASE ";": CALL ScaleπEND SELECTππIF INSTR(" ZXCVBNMASDFGHJQWERTYUI678", key$) > 1 THENπ COLOR 3π IF tst = 1 THEN tst$ = "ON " ELSE tst$ = "OFF"π IF vst = 1 THEN vst$ = "ON " ELSE vst$ = "OFF"π LOCATE 5, 4: PRINT "Tremolo: "; tst$π LOCATE 6, 4: PRINT "Vibrato: "; vst$π LOCATE 5, 69: PRINT "Decay: "; HEX$(dcay)π IF xold <> 0 THEN LOCATE 26, xold: COLOR 11: PRINT ochar$π IF xpos <> 0 THEN LOCATE 26, xpos: COLOR 4: PRINT char$π ochar$ = char$: xold = xposπEND IFπLOOP WHILE key$ <> "0"πCOLOR 11πEND SUBππFUNCTION note% (n$)π'These appear to be the correct frequency numbersπIF n$ = "C" THEN note% = &H209πIF n$ = "C#" THEN note% = &H219πIF n$ = "D" THEN note% = &H229πIF n$ = "D#" THEN note% = &H23BπIF n$ = "E" THEN note% = &H24EπIF n$ = "F" THEN note% = &H261πIF n$ = "F#" THEN note% = &H277πIF n$ = "G" THEN note% = &H28DπIF n$ = "G#" THEN note% = &H2A4πIF n$ = "A" THEN note% = &H2BDπIF n$ = "A#" THEN note% = &H2D8πIF n$ = "B" THEN note% = &H2F4πEND FUNCTIONππFUNCTION offset1 (channel)π'These are the offsets for each of the nine channelsπ'For operator number 1πIF channel = 1 THEN offset1 = &H0πIF channel = 2 THEN offset1 = &H1πIF channel = 3 THEN offset1 = &H2πIF channel = 4 THEN offset1 = &H8πIF channel = 5 THEN offset1 = &H9πIF channel = 6 THEN offset1 = &HAπIF channel = 7 THEN offset1 = &H10πIF channel = 8 THEN offset1 = &H11πIF channel = 9 THEN offset1 = &H12πEND FUNCTIONπππFUNCTION offset2 (channel)π'These are the offsets for each of the nine channelsπ'For operator number 2πIF channel = 1 THEN offset2 = &H3πIF channel = 2 THEN offset2 = &H4πIF channel = 3 THEN offset2 = &H5πIF channel = 4 THEN offset2 = &HBπIF channel = 5 THEN offset2 = &HCπIF channel = 6 THEN offset2 = &HDπIF channel = 7 THEN offset2 = &H13πIF channel = 8 THEN offset2 = &H14πIF channel = 9 THEN offset2 = &H15πEND FUNCTIONππSUB pause (secs!)πstart! = TIMERπDO: LOOP WHILE TIMER - start! < secs!πEND SUBππSUB pressakeyπDO: LOOP WHILE INKEY$ = ""πEND SUBππSUB SBDrum (num%)πIF num% = 1 THEN CALL WriteReg(&HBD, &H21) 'HHatπIF num% = 2 THEN CALL WriteReg(&HBD, &H22) 'CymbπIF num% = 3 THEN CALL WriteReg(&HBD, &H24) 'TomTπIF num% = 4 THEN CALL WriteReg(&HBD, &H28) 'SnreπIF num% = 5 THEN CALL WriteReg(&HBD, &H30) 'BassπCALL WriteReg(&HBD, &H0)πEND SUBππSUB SBPlay (channel%, n$, Octa%)πIF Octa% = 1 THEN octave = &H21 'These are the octave bitsπIF Octa% = 2 THEN octave = &H25πIF Octa% = 3 THEN octave = &H29πIF Octa% = 4 THEN octave = &H2DπIF Octa% = 5 THEN octave = &H31πIF Octa% = 6 THEN octave = &H35πIF Octa% = 7 THEN octave = &H39πoffs1 = offset1(channel) 'Get offsets dependingπoffs2 = offset2(channel) 'on channelπIF tst = 1 THEN trem = &H80 ELSE trem = &H0πIF vst = 1 THEN vibr = &H40 ELSE vibr = &H0ππCALL WriteReg(&HB0 + offs1, &H0) 'Clear previous noteπCALL WriteReg(&H20 + offs1, &H0 + trem + vibr) 'Amp/Vib/EG/KSR/Octave(0-F)πCALL WriteReg(&H40 + offs1, &HA) 'Scale Lev/Volume(0-3F)πCALL WriteReg(&H60 + offs1, &HF0 + dcay) 'Attack/DecayπCALL WriteReg(&H80 + offs1, &H1A) 'Sustain/ReleaseπCALL WriteReg(&HA0 + offs1, note(n$)) 'NoteπCALL WriteReg(&HE0 + offs1, &H0) 'Waveform (00-03) Default 00ππCALL WriteReg(&H20 + offs2, &H0 + trem + vibr) 'Amp/Vib/EG/KSR/Octave(0-F)πCALL WriteReg(&H40 + offs2, &HA) 'Scale Lev/Volume(0-3F)πCALL WriteReg(&H60 + offs2, &HF0 + dcay) 'Attack/DecayπCALL WriteReg(&H80 + offs2, &H1A) 'Sustain/ReleaseπCALL WriteReg(&HB0 + offs1, octave) 'Octave(21-39)πCALL WriteReg(&HE0 + offs2, &H0) 'Waveform (00-03) Default 00πEND SUBππSUB ScaleπFOR octave = 1 TO 7πCALL SBPlay(3, "C", octave): pause .1πCALL SBPlay(1, "C#", octave): pause .1πCALL SBPlay(2, "D", octave): pause .1πCALL SBPlay(3, "D#", octave): pause .1πCALL SBPlay(1, "E", octave): pause .1πCALL SBPlay(2, "F", octave): pause .1πCALL SBPlay(3, "F#", octave): pause .1πCALL SBPlay(1, "G", octave): pause .1πCALL SBPlay(2, "G#", octave): pause .1πCALL SBPlay(3, "A", octave): pause .1πCALL SBPlay(1, "A#", octave): pause .1πCALL SBPlay(2, "B", octave): pause .1πNEXT octaveπEND SUBππDEFSNG A-ZπSUB WriteReg (Reg%, value%)πOUT StatusP, Reg% 'Register to write at port &H388πFOR lp = 1 TO 6 'Wait 3.3 msecπwat = INP(&H388)πNEXT lpπOUT DataP, value% 'Now write data to port &H389πFOR lp = 1 TO 35 'Now wait 23 msecπwat = INP(&H389)πNEXT lpπEND SUBππCharles Godard PERCENT BOX FidoNet QUIK_BAS Echo 06-22-96 (00:00) QB, QBasic, PDS 149 4264 PERCENT.BAS 'Percent.bas by Charles Godard 06/22/96π'Opens, maintains, then closes a popup box to be used whenπ'copying a file or performing other task, to pacify the userπ'while he waits.ππ'Switch% = 0 turns it onπ'Switch% = 1 maintains itπ'Switch% = 2 closes itπ'Pass to it, a number between 1 and 100 and the proper switchπ'PercentBox 0, 0 'you must 1st open the boxπ'PercentBox 1, (Percent%) 'maintain it with this. Percent%π' MUST be in parenthesis or else MUST be a numeric value.π'PercentBox 2, 0 'close it with thisπ'give it a number between 0 and 100, and increment it as neededπ'the delay's, STEP, and for/next are for demo onlyππ'I haven't tested this except in this program. It could need someπ'modification when run in a real program. <Oh well> :)ππ'inspired by reading in the conference.. Wellerstein to Goldbloomπ'BTW, Alex, I liked yours, never got James' to run. PB, I guess :)ππ'I feel like the shipwrecked sailor, sending messages in a bottle.π'If anyone sees this message in a bottle, I sure would like toπ'hear about it. I've been posting messages since feb, and theπ'only response that I have gotten was the one the other day fromπ'Joe. I'm hoping that I am now making the trip! :)ππDEFINT A-ZπDECLARE SUB printScreen (Tr, Lc, H, W, Fg, Bg)πDECLARE SUB copyScreen (Tr, Lc, H, W)πDECLARE SUB PercentBox (Switch%, Percent%)ππTYPE Sdataπ Char AS STRING * 1π Attr AS STRING * 1πEND TYPEπREDIM SHARED x(25, 80) AS SdataπDIM SHARED Bg, FgπCLSπSCREEN 0π'put stuff on screenπCOLOR &H7, 1: FOR i = 292 TO 678: PRINT i; : NEXT iππPercentBox 0, 0ππDly = 1: GOSUB delayπ FOR Percent% = 1 TO 100 STEP 9π PercentBox 1, (Percent%) 'you can change the name ofπ GOSUB delay 'Percent% and remove the ()π NEXT Percent%πGOSUB delayππPercentBox 2, 0ππENDππdelay:πT& = TIMER: DO WHILE (ABS(T& - TIMER) < Dly) AND INKEY$ = "": LOOPπRETURNππSUB copyScreen (Tr, Lc, H, W)ππ'Attr = SCREEN(Tr + 1, Lc + 1, 1)π'Fg = Attr AND &HFπ'Bg = Attr \ &H10ππFOR cr = Tr TO Tr + Hπ FOR cc = Lc TO Lc + Wπ x(cr, cc).Char = CHR$(SCREEN(cr, cc))π x(cr, cc).Attr = CHR$(SCREEN(cr, cc, 1))π NEXT ccπNEXT crππEND SUBππSUB PercentBox (Switch%, Percent%)πTr = 11: Lc = 20: W = 43: H = 4: 'Fg = &H4: Bg = &H4:ππSTATIC boxOpenππSELECT CASE Switch%π CASE IS = 0 'open the boxπ 'read data from the screenπ CALL copyScreen(Tr, Lc, H, W)π 'put popup on screenπ FOR cr = Tr TO Tr + Hπ LOCATE cr, Lcπ COLOR 4, 4π PRINT STRING$(W, " ")π NEXT crπ π boxOpen = 1π π 'set up border stylesπ BDRtl = 218: BDRtr = 191: BDRlc = 192: BDRrc = 217: 'cornersπ BDRv = 179: BDRh = 196: 'horizontal, vertical sidesππ 'Bdr top leftπ COLOR &HE, 4π LOCATE Tr, Lc: PRINT CHR$(BDRtl); 'top lt corner BDRπ 'top BDR top horizontalπ FOR i = Tr TO Tr + W - 2: PRINT CHR$(BDRh); : NEXT iπ 'top BDR Rt cornerπ LOCATE Tr, Lc + W: PRINT ; CHR$(BDRtr);π 'Lt BDR verticalπ FOR i = Tr + 1 TO Tr + H - 1: LOCATE i, Lc: PRINT CHR$(BDRv); : LOCATE i, Lc + W: PRINT CHR$(BDRv); : NEXT iπ 'bottom rt cornerπ LOCATE Tr + H, Lc + W: PRINT CHR$(BDRrc);π 'left cornerπ LOCATE Tr + H, Lc: PRINT CHR$(BDRlc)π 'right horizontalπ LOCATE Tr + H, Lc + 1: FOR i = Lc TO Lc + W - 2:π PRINT CHR$(BDRh); : NEXTππ CASE IS = 1 'maintain boxπ IF boxOpen = 1 THENπ LOCATE Tr, Lc + 19: PRINT STR$(Percent%); "%"π Percent% = (Percent% / 100) * 40π LOCATE Tr + 2, Lc + 2: PRINT STRING$(Percent%, "█")π END IFπ π CASE IS = 2π 'Close PercentBoxπ IF boxOpen = 1 THENπ boxOpen = 0π CALL printScreen(Tr, Lc, H, W, Fg, Bg)π END IFπ CASE ELSEπEND SELECTππEND SUBππSUB printScreen (Tr, Lc, H, W, Fg, Bg)ππCOLOR Fg, BgππFOR cr = Tr TO Tr + Hπ FOR cc = Lc TO Lc + Wπ LOCATE cr, ccπ Attr = ASC(x(cr, cc).Attr)π Fg = Attr AND &HFπ Bg = Attr \ &H10π COLOR Fg, Bgπ PRINT x(cr, cc).Char;π NEXT ccπNEXT crππEND SUBπDarryl Schneider ENCODE/DECODE MESSAGE fish2@datanet.ab.ca 07-17-96 (19:37) QB, QBasic, PDS 463 12945 QCODE.BAS 'QCode - Version 1.0π'π'Messages can be encoded and decodedπ'with QCode. A password is required toπ'view a message, and is specified whenπ'writing a message. Make sure everythingπ'is in the C:\ directory and you willπ'have no problem. Enjoy!π'π'Written by Darryl Schneiderπ'fish2@datanet.ab.caπ'The QBasic Zoneπ'http://www.geocities.com/SiliconValley/8191/π'πSCREEN 12 'set screen mode to 12 andπDEFSTR A-B, D-M, R, U 'give some standard variableπDEFINT N-Q, S-T, V-W 'settingsπDEFLNG X-ZππDIM CURSOR(1 TO 500) 'draw the triangle cursorπLINE (50, 50)-(50, 66), 3πLINE (50, 50)-(66, 58), 3πLINE (50, 66)-(66, 58), 3πPAINT (55, 55), 6, 3πGET (50, 50)-(66, 66), CURSORππENTER = CHR$(13) 'define all of the arrow keysπUP = CHR$(0) + CHR$(72)πDOWN = CHR$(0) + CHR$(80)πLEFT = CHR$(0) + CHR$(75)πRIGHT = CHR$(0) + CHR$(77)ππMAINMENU: 'just look at the label toπCLS 'find out what this sectionπLINE (160, 48)-(480, 230), 11, BF 'is aboutπLINE (160, 48)-(480, 63), 12, BFπLOCATE 4, 38: COLOR 14: PRINT "QCode"πCOLOR 15πLOCATE 7, 35: PRINT "Write a message"πLOCATE 9, 35: PRINT "View a message"πLOCATE 11, 35: PRINT "About QCode"πLOCATE 13, 35: PRINT "Quit"ππMM1: 'write a messageπLINE (240, 70)-(270, 220), 11, BFπPUT (250, 95), CURSORπDOπA1 = INKEY$πIF A1 = ENTER THEN GOSUB WRITEMESSAGEπIF A1 = UP THEN GOSUB MM4πIF A1 = DOWN THEN GOSUB MM2πLOOPππMM2: 'view a messageπLINE (240, 70)-(270, 220), 11, BFπPUT (250, 126), CURSORπDOπA2 = INKEY$πIF A2 = ENTER THEN GOSUB VIEWMESSAGEπIF A2 = UP THEN GOSUB MM1πIF A2 = DOWN THEN GOSUB MM3πLOOPππMM3: 'go to the about screenπLINE (240, 70)-(270, 220), 11, BFπPUT (250, 159), CURSORπDOπA3 = INKEY$πIF A3 = ENTER THEN GOSUB ABOUTπIF A3 = UP THEN GOSUB MM2πIF A3 = DOWN THEN GOSUB MM4πLOOPππMM4: 'quitπLINE (240, 70)-(270, 220), 11, BFπPUT (250, 191), CURSORπDOπA4 = INKEY$πIF A4 = ENTER THEN GOSUB QUITπIF A4 = UP THEN GOSUB MM3πIF A4 = DOWN THEN GOSUB MM1πLOOPππWRITEMESSAGE:πCLSπMNAME = ""πMPASSWORD = ""πMESSAGE = ""πMESSAGE1 = ""πSSAVE = 0ππOPEN "C:\UNTITLED.MSG" FOR OUTPUT AS #1πWRITE #1, MPASSWORDπWRITE #1, MESSAGEπCLOSE #1ππOPEN "C:\UNTITLED.MSG" FOR OUTPUT AS #2πLINE (0, 0)-(640, 17), 12, BFπCOLOR 14πLOCATE 1, 28: PRINT "QCode - Writing a Message"πCOLOR 15πLOCATE 3, 10: INPUT "Message Name (max. 8 characters): ", MNAMEπLOCATE 4, 10: INPUT "Message Password: ", MPASSWORDπMNAME = UCASE$(MNAME)πMPASSWORD = UCASE$(MPASSWORD) 'create a message name andπWRITE #2, MPASSWORD 'passwordπLOCATE 6, 10: PRINT "Enter Message: "πN1 = 8πN2 = 1πNEXTLETTER1:πDO 'message is enteredπB1 = UCASE$(INKEY$)πIF B1 = "A" THEN B2 = "^" 'these are all of the characterπIF B1 = "B" THEN B2 = "Z" 'representationsπIF B1 = "C" THEN B2 = "<"πIF B1 = "D" THEN B2 = ":"πIF B1 = "E" THEN B2 = "W"πIF B1 = "F" THEN B2 = "Y"πIF B1 = "G" THEN B2 = "~"πIF B1 = "H" THEN B2 = "#"πIF B1 = "I" THEN B2 = "N"πIF B1 = "J" THEN B2 = "F"πIF B1 = "K" THEN B2 = "I"πIF B1 = "L" THEN B2 = "."πIF B1 = "M" THEN B2 = "P"πIF B1 = "N" THEN B2 = "X"πIF B1 = "O" THEN B2 = "*"πIF B1 = "P" THEN B2 = "&"πIF B1 = "Q" THEN B2 = "V"πIF B1 = "R" THEN B2 = "H"πIF B1 = "S" THEN B2 = "C"πIF B1 = "T" THEN B2 = "-"πIF B1 = "U" THEN B2 = "%"πIF B1 = "V" THEN B2 = "L"πIF B1 = "W" THEN B2 = "E"πIF B1 = "X" THEN B2 = "A"πIF B1 = "Y" THEN B2 = "B"πIF B1 = "Z" THEN B2 = "?"πIF B1 = "1" THEN B2 = "9"πIF B1 = "2" THEN B2 = "6"πIF B1 = "3" THEN B2 = "4"πIF B1 = "4" THEN B2 = "3"πIF B1 = "5" THEN B2 = "1"πIF B1 = "6" THEN B2 = "7"πIF B1 = "7" THEN B2 = "8"πIF B1 = "8" THEN B2 = "2"πIF B1 = "9" THEN B2 = "5"πIF B1 = "." THEN B2 = "G"πIF B1 = "," THEN B2 = "$"πIF B1 = "!" THEN B2 = "("πIF B1 = "$" THEN B2 = ")"πIF B1 = "@" THEN B2 = "="πIF B1 = "-" THEN B2 = "+"πIF B1 = "*" THEN B2 = "\"πIF B1 = "?" THEN B2 = "/"πIF B1 = "0" THEN B2 = "S"πIF B1 = " " THEN B2 = " "πIF B1 = "'" THEN B2 = "K"πIF B1 = ENTER THEN GOSUB SAVEMESSAGEπLOOP UNTIL B1 <> ""πLOCATE N1, N2: PRINT B1πN2 = N2 + 1πIF N2 = 60 THENπ N2 = 1π N1 = N1 + 1πEND IFπMESSAGE1 = MESSAGE1 + B1 'puts all of the letters intoπMESSAGE = MESSAGE + B2 'one stringπB1 = ""πGOSUB NEXTLETTER1ππSAVEMESSAGE:πCLSπLINE (0, 0)-(640, 17), 12, BFπCOLOR 14πLOCATE 1, 28: PRINT "QCode - Writing a Message"πCOLOR 15πLOCATE 3, 10: PRINT MESSAGE1πLINE (100, 405)-(540, 440), 11, BFπLINE (100, 405)-(540, 440), 12, BπLOCATE 27, 18: PRINT "Save Message"πLOCATE 27, 36: PRINT "Print Message"πLOCATE 27, 55: PRINT "Main Menu"ππWM1: 'saves the message in .msg formatπPUT (115, 415), CURSORπDOπE1 = INKEY$πIF E1 = ENTER THENπ WRITE #2, MESSAGEπ CLOSE #2π FILENAME = "C:\" + MNAME + ".MSG"π NAME "C:\UNTITLED.MSG" AS FILENAMEπ CLOSE #2π SSAVE = 1π GOSUB WM1πEND IFπIF E1 = LEFT THENπ LINE (115, 415)-(131, 431), 11, BFπ GOSUB WM3πEND IFπIF E1 = RIGHT THENπ LINE (115, 415)-(131, 431), 11, BFπ GOSUB WM2πEND IFπLOOPππWM2: 'prints the messageπPUT (260, 415), CURSORπDOπE2 = INKEY$πIF E2 = ENTER THENπ LPRINT "QCode Message"π LPRINT ""π IF SSAVE = 1 THEN LPRINT "File: "; FILENAMEπ LPRINT ""π LPRINT "Original Message:"π LPRINT ""π LPRINT " "; MESSAGE1π LPRINT ""π LPRINT "Coded Message:"π LPRINT ""π LPRINT " "; MESSAGEπ LPRINT ""π LPRINT ""π LPRINT "QCode was written by Darryl Schneider"π LPRINT ""π LPRINT ""π LPRINT ""π GOSUB WM2πEND IFπIF E2 = LEFT THENπ LINE (260, 415)-(276, 431), 11, BFπ GOSUB WM1πEND IFπIF E2 = RIGHT THENπ LINE (260, 415)-(276, 431), 11, BFπ GOSUB WM3πEND IFπLOOPππWM3: 'return to main menuπPUT (412, 415), CURSORπDOπE3 = INKEY$πIF E3 = ENTER THENπ IF SSAVE = 0 THENπ CLOSE #2π KILL "C:\UNTITLED.MSG"π END IFπ GOSUB MAINMENUπEND IFπIF E3 = LEFT THENπ LINE (412, 415)-(428, 431), 11, BFπ GOSUB WM2πEND IFπIF E3 = RIGHT THENπ LINE (412, 415)-(428, 431), 11, BFπ GOSUB WM1πEND IFπLOOPππVIEWMESSAGE:πCLSπN3 = 8πN4 = 1πN5 = 8πN6 = 1πMNAME = ""πMPASSWORD = ""πMESSAGE = ""πMP1 = ""πMP2 = ""ππLINE (0, 0)-(640, 17), 12, BFπCOLOR 14πLOCATE 1, 28: PRINT "QCode - Viewing a Message"πCOLOR 15πLOCATE 3, 10: INPUT "Message Name (max. 8 characters): ", DNAMEπLOCATE 4, 10: INPUT "Message Password: ", DPASSWORDπDNAME = UCASE$(DNAME)πDPASSWORD = UCASE$(DPASSWORD)πJFILE = "C:\" + DNAME + ".MSG"πOPEN JFILE FOR INPUT AS #3 'opens a QCode file forπINPUT #3, MPASSWORD 'viewingππVIEWME:πLOCATE 6, 10: PRINT "Message: "; JFILEπINPUT #3, MESSAGEπY = LEN(MESSAGE)πS = 1πIF DPASSWORD = MPASSWORD THEN 'if password is correct,π DO 'displays decoded messageπ B3 = MID$(MESSAGE, S, 1)π IF B3 = "^" THEN B4 = "A" 'these are all of theπ IF B3 = "Z" THEN B4 = "B" 'character representationsπ IF B3 = "<" THEN B4 = "C"π IF B3 = ":" THEN B4 = "D"π IF B3 = "W" THEN B4 = "E"π IF B3 = "Y" THEN B4 = "F"π IF B3 = "~" THEN B4 = "G"π IF B3 = "#" THEN B4 = "H"π IF B3 = "N" THEN B4 = "I"π IF B3 = "F" THEN B4 = "J"π IF B3 = "I" THEN B4 = "K"π IF B3 = "." THEN B4 = "L"π IF B3 = "P" THEN B4 = "M"π IF B3 = "X" THEN B4 = "N"π IF B3 = "*" THEN B4 = "O"π IF B3 = "&" THEN B4 = "P"π IF B3 = "V" THEN B4 = "Q"π IF B3 = "H" THEN B4 = "R"π IF B3 = "C" THEN B4 = "S"π IF B3 = "-" THEN B4 = "T"π IF B3 = "%" THEN B4 = "U"π IF B3 = "L" THEN B4 = "V"π IF B3 = "E" THEN B4 = "W"π IF B3 = "A" THEN B4 = "X"π IF B3 = "B" THEN B4 = "Y"π IF B3 = "?" THEN B4 = "Z"π IF B3 = "9" THEN B4 = "1"π IF B3 = "6" THEN B4 = "2"π IF B3 = "4" THEN B4 = "3"π IF B3 = "3" THEN B4 = "4"π IF B3 = "1" THEN B4 = "5"π IF B3 = "7" THEN B4 = "6"π IF B3 = "8" THEN B4 = "7"π IF B3 = "2" THEN B4 = "8"π IF B3 = "5" THEN B4 = "9"π IF B3 = "S" THEN B4 = "0"π IF B3 = "G" THEN B4 = "."π IF B3 = "$" THEN B4 = ","π IF B3 = "(" THEN B4 = "!"π IF B3 = ")" THEN B4 = "$"π IF B3 = "=" THEN B4 = "@"π IF B3 = "+" THEN B4 = "-"π IF B3 = "\" THEN B4 = "*"π IF B3 = "/" THEN B4 = "?"π IF B3 = " " THEN B4 = " "π IF B3 = "K" THEN B4 = "'"π LOCATE N3, N4: PRINT B4π MP1 = MP1 + B4π N4 = N4 + 1π S = S + 1π IF N4 = 60 THENπ N4 = 1π N3 = N3 + 1π END IFπ LOOP UNTIL S = Y + 1πEND IFππIF NOT DPASSWORD = MPASSWORD THEN 'if password is incorrect,π DO 'displays encoded messageπ B5 = MID$(MESSAGE, S, 1)π LOCATE N5, N6: PRINT B5π MP2 = MP2 + B5π N6 = N6 + 1π S = S + 1π IF N6 = 60 THENπ N6 = 1π N5 = N5 + 1π END IFπ LOOP UNTIL S = Y + 1πEND IFπ πCLOSE #3ππLINE (170, 405)-(470, 440), 11, BFπLINE (170, 405)-(470, 440), 12, BπLOCATE 27, 28: PRINT "Print Message"πLOCATE 27, 48: PRINT "Main Menu"ππVM1: 'prints the messageπPUT (195, 415), CURSORπDOπE4 = INKEY$πIF E4 = ENTER THENπ LPRINT "QCode Message"π LPRINT ""π IF SSAVE = 1 THEN LPRINT "File: "; FILENAMEπ LPRINT ""π LPRINT "Original Message:"π LPRINT ""π IF MP1 <> "" THEN LPRINT " "; MP1π IF MP2 <> "" THEN LPRINT " Sorry, you need the password!"π LPRINT ""π LPRINT "Coded Message:"π LPRINT ""π LPRINT " "; MESSAGEπ LPRINT ""π LPRINT ""π LPRINT "QCode was written by Darryl Schneider"π LPRINT ""π LPRINT ""π LPRINT ""π GOSUB VM1πEND IFπIF E4 = LEFT THENπ LINE (195, 415)-(211, 431), 11, BFπ GOSUB VM2πEND IFπIF E4 = RIGHT THENπ LINE (195, 415)-(211, 431), 11, BFπ GOSUB VM2πEND IFπLOOPππVM2: 'returns to main menuπPUT (355, 415), CURSORπDOπE5 = INKEY$πIF E5 = ENTER THENπ GOSUB MAINMENUπEND IFπIF E5 = LEFT THENπ LINE (355, 415)-(371, 431), 11, BFπ GOSUB VM1πEND IFπIF E5 = RIGHT THENπ LINE (355, 415)-(371, 431), 11, BFπ GOSUB VM1πEND IFπLOOPππABOUT: 'the infamous about screenπCLSπLINE (0, 0)-(640, 17), 12, BFπCOLOR 14πLOCATE 1, 35: PRINT "About QCode"πCOLOR 15πPRINT ""πPRINT ""πPRINT "QCode was written in Microsoft QuickBasic by Darryl Schneider. The"πPRINT "program is a message encoder/decoder. To use the program, first write"πPRINT "a message. All message files are saved to the C:\ drive. The message"πPRINT "name that you choose can be a maximum of 8 characters. No file extension"πPRINT "or drive specification is required in the message name. The password"πPRINT "is the key to opening the message. You must know the password to that"πPRINT "particular message in order to decode it. Once you have finished writing"πPRINT "the message, you may view it by selecting the option at the main menu."πPRINT "Then just type in the message name and the password for that message,"πPRINT "and it will be decoded. I included a print option so you can print"πPRINT "out each of the messages. I hope you like the program. Enjoy!"πPRINT ""πPRINT "Darryl Schneider"πPRINT "fish2@datanet.ab.ca"πPRINT "The QBasic Zone"πPRINT "http://www.geocities.com/SiliconValley/8191/"ππLINE (270, 405)-(370, 440), 11, BF 'draw the box at theπLINE (270, 405)-(370, 440), 12, B 'bottom of the screenπLOCATE 27, 38: PRINT "Main Menu"ππPUT (275, 415), CURSORπDOπG1 = INKEY$πIF G1 = ENTER THEN GOSUB MAINMENU 'return to the main menuπLOOPππQUIT:πENDππ'End of QCodeπJonathan Leger FAST PRINT REPLACEMENT leger@mail.dtx.net 08-01-96 (11:34) QB, QBasic, PDS 230 9505 XPRINT.BAS ' This is a TWO part snippet (XPRINT.BAS and XPRINT.8 to follow)ππ'******************π'*** XPRINT.BAS ***π'****************************************************************************π'*** This program will demonstrate the superior speed of Xprint over ***π'*** Qbasic and QuickBASIC's PRINT, COLOR and LOCATE statements. ***π'*** Xprint is typically about 350% - 400% faster than Qbasic and from ***π'*** 30% - 60% faster than QuickBASIC. ***π'*** ***π'*** HOWEVER! Please note that Xprint() performs _no_ error checking ***π'*** except for making sure the string is longer than 0 bytes, while ***π'*** QuickBASIC wont let you print off the screen, etc. If this program ***π'*** did that error checking, it would be as slow as QuickBASIC, which ***π'*** would defeat the purpose! Absence of this error checking is not *** π'*** dangerous unless you're printing a string that's longer than 16,000 ***π'*** bytes to the screen (and I'm not even sure if that's completely ***π'*** dangerous...), which will go outside the bounds of your screen ***π'*** memory. Anyone, however, who would do this is clearly not too swift ***π'*** (mentally speaking) and probably needs to have his computer crash on ***π'*** him every now and again to wake him up. ***π'****************************************************************************π'*** This demonstration program and the Xprint() routines were written by ***π'*** Jonathan Leger (leger@mail.dtx.net), and may be freely distributed ***π'*** to anybody. These routines are 100% absolutely no lies or nothin' ***π'*** FREE to the general public. You can send me e-mail to praise my ***π'*** genious if you want, but I require nothing more. *grin* ***π'****************************************************************************ππDEFINT A-Zππ'*** The declaration of Absolute() is required for QB, which must be loadedπ'*** with "/L QB" for it to work. The declartion in Qbasic is optional.πDECLARE SUB Absolute (arg1%, arg2%, arg3%, arg4%, arg5%, arg6%, arg7%, offset%)ππ'*** readyXprint() stores the machine language Xprint() routine, and must beπ'*** called before using the Xprint. Note, though, that it only needs to beπ'*** called _once_.πDECLARE SUB readyXprint ()ππ'*** The actual Xprint() routine. Prints s$ to coordintes (x%,y%) on theπ'*** screen in color fore%, back%. Notice, though, that to keep the feelπ'*** of BASIC's LOCATE, which is in the format LOCATE Y, X, the Y precedesπ'*** the X in the Xprint() routine also.πDECLARE SUB Xprint (s$, y%, x%, fore%, back%)ππ'*** This sub is used only in the demonstration, so you can trash it if youπ'*** don't want it.πDECLARE SUB testXprint ()ππSCREEN 0πWIDTH 80, 25ππreadyXprint 'This routine must be called before using Xprint!π 'You only have to call it once though. :)ππtestXprint 'Lessee some comparisons...ππDEFSNG A-Zπ'**********************π'*** readyXprint() *π'**************************************************************************π'*** This routine loads the xprint machine-language program into the ***π'*** xprint.asm$ string for use by the Xprint() routine. This program ***π'*** _must_ be called before using the Xprint() routine, or the program ***π'*** will crash! ***π'**************************************************************************π'*** All questions and comments welcome. Send inquries to the me at ***π'*** leger@mail.dtx.net ***π'**************************************************************************πSUB readyXprintππSHARED asm$ππ'*** This is the actual X-print program.π'*** It was written using A86--a truly beautiful assembler!ππasm$ = ""πasm$ = asm$ + CHR$(85) + CHR$(137) + CHR$(229) + CHR$(131)πasm$ = asm$ + CHR$(126) + CHR$(10) + CHR$(0) + CHR$(116) + CHR$(66)πasm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(14) + CHR$(131) + CHR$(239)πasm$ = asm$ + CHR$(1) + CHR$(137) + CHR$(251) + CHR$(193) + CHR$(231)πasm$ = asm$ + CHR$(7) + CHR$(193) + CHR$(227) + CHR$(5) + CHR$(3)πasm$ = asm$ + CHR$(251) + CHR$(131) + CHR$(110) + CHR$(12) + CHR$(1)πasm$ = asm$ + CHR$(209) + CHR$(102) + CHR$(12) + CHR$(3) + CHR$(126)πasm$ = asm$ + CHR$(12) + CHR$(139) + CHR$(86) + CHR$(18) + CHR$(193)πasm$ = asm$ + CHR$(226) + CHR$(4) + CHR$(3) + CHR$(86) + CHR$(16)πasm$ = asm$ + CHR$(30) + CHR$(142) + CHR$(94) + CHR$(8) + CHR$(139)πasm$ = asm$ + CHR$(118) + CHR$(6) + CHR$(80) + CHR$(184) + CHR$(0)πasm$ = asm$ + CHR$(184) + CHR$(142) + CHR$(192) + CHR$(88) + CHR$(139)πasm$ = asm$ + CHR$(78) + CHR$(10) + CHR$(138) + CHR$(4) + CHR$(38)πasm$ = asm$ + CHR$(136) + CHR$(5) + CHR$(38) + CHR$(136) + CHR$(85)πasm$ = asm$ + CHR$(1) + CHR$(70) + CHR$(71) + CHR$(71) + CHR$(226)πasm$ = asm$ + CHR$(242) + CHR$(31) + CHR$(93) + CHR$(203)ππEND SUBππDEFINT A-ZπSUB testXprintππLOCATE , , 0πCLSππLOCATE 1, 1πCOLOR 7, 0πPRINT "XPRINT"ππt.xprint# = TIMERπFOR redraw = 1 TO 100π back = INT(RND * 7) + 1π FOR y = 2 TO 25π Xprint STRING$(80, " "), y, 1, 7, backπ NEXT yπNEXT redrawπt.xprint# = TIMER - t.xprint#ππCLSπLOCATE 1, 1πCOLOR 7, 0πPRINT "BASIC"πt.basic# = TIMERπFOR redraw = 1 TO 100π COLOR 7, INT(RND * 7) + 1π FOR y = 2 TO 25π LOCATE y, 1π PRINT STRING$(80, " ");π NEXT yπNEXT redrawπt.basic# = TIMER - t.basic#ππCOLOR , 0πCLSπPRINT "XPrint redrew the screen 100 times in"; t.xprint#; "seconds."πPRINT "BASIC redrew the screen 100 times in"; t.basic#; "seconds."πPRINTπPRINT "XPrint was approximately"; INT((t.basic# / t.xprint#) * 100); "% faster."πEND SUBππ'*****************π'*** Xprint() *π'**************************************************************************π'*** Arguments: ***π'*** s$ = string to print ***π'*** y% = line to print at ***π'*** x% = column to print at ***π'*** fore% = foreground color (normal BASIC numbering used) ***π'*** back% = background color (normal BASIC numbering used) ***π'**************************************************************************π'*** This routine was written by Jonathan Leger (leger@mail.dtx.net) ***π'*** using the A86 assembler. The assembly-language file can be viewed ***π'*** for further study (XPRINT.8). ***π'**************************************************************************π'*** All questions and comments welcome. Send inquries to the above ***π'*** e-mail address. ***π'**************************************************************************πSUB Xprint (s$, y%, x%, fore%, back%)ππSHARED asm$ππDEF SEG = VARSEG(asm$)π CALL Absolute(BYVAL back%, BYVAL fore%, BYVAL y%, BYVAL x%, BYVAL LEN(s$), BYVAL VARSEG(s$), BYVAL SADD(s$), SADD(asm$))πDEF SEGππEND SUBππ;--------------------8<----[ Begin XPRINT.8 ]---->8---------------------ππ;*** Xprint for BASIC.π;*** Prints a string to coordintes y%, x%, with color f%, b%, real fast. :)π;*** call like this:π;***π;*** Call Absolute (b%, f%, y%, x%, len(s$), sadd(s$), varptr(s$), offset%)π;***π;*** WARNING: This routine does _no_ error checking to see if you're goingπ;*** off-screen with the string (for speed purposes), so pleaseπ;*** be sure to check that in your program!ππPUSH BP ;preserve BP!πMOV BP,SPππSTRUC [BP]π JUNK1 DW ?π JUNK2 DW ?π JUNK3 DW ? ;the junk we don't need!π STR_OFF DW ? ;our string pointer [bp+6]π STR_SEG DW ? ;our string segment [bp+8]π LEN DW ? ;our string length [bp+0a]π X DW ? ;our x location [bp+0c]π Y DW ? ;our y location [bp+0e]π FORE DW ? ;foreground color [bp+10]π BACK DW ? ;background color [bp+12]πENDSππCMP LEN,00πJE DoneππMOV DI,Y ;get the offset for the starting characterπSUB DI,1 ;using the formula:πMOV BX,DI ; ( ( ( Y - 1 ) * 80 ) + X )πSHL DI,7πSHL BX,5πADD DI,BXπSUB X,1πSHL X,1πADD DI,X ;DI now contains the starting offset.ππMOV DX,BACK ;calculate the color value using the formula:πSHL DX,4 ; ( FOREGROUND + ( BACKGROUND * 16 ) )πADD DX,FOREππPUSH DSππMOV DS,STR_SEG ;string segmentπMOV SI,STR_OFF ;string offsetπMOV ES,0B800 ;screen offset for color scren 0πMOV CX,LENππPrintChar:πMOV AL,DS:[SI] ;put next character into ALπMOV ES:B[DI],AL ;write it to screenπMOV ES:B[DI+1],DL ;write color value to screenπINC SI ;next characterπINC DI,2 ;next screen coordinateπLOOP PrintCharππDone:ππPOP DS ;restore DS for BASICπPOP BP ;restore BP for BASICπRETF ;return to BASIC!πKurt Kuzba LINE INPUT REPLACEMENT FidoNet QUIK_BAS Echo 03-21-96 (00:00) QB, QBasic, PDS 82 3422 ELVIS.BAS '> Is here a way to get rig of cntrl-break?π'>................π' Use INKEY$ instead of INPUT. Have a look at this.π'_|_|_| ELVIS.BASπ'_|_|_| This program allows the input of 'larger than life'π'_|_|_| strings with limited editing windows on the screen.π'_|_|_| BACKSPACE, HOME, END, LEFT, RIGHT, INSERT, DELETE,π'_|_|_| and ESCAPE are all active in the input routine.π'_|_|_| No warrantees or guarantees are given or implied.π'_|_|_| Released to PUBLIC DOMAIN by Kurt Kuzba. (3/21/96)πDECLARE SUB Elvus (prompt$, max%, winsiz%, S$, sequins%)πDECLARE FUNCTION Elvis$ (prompt$, max%, winsiz%, S$, sequins%)πPRINTπPath$ = "C:\": p$ = "Please Enter Your Path =>"πMystr$ = Elvis$(p$, 32, 8, Path$, 0)πPRINT : PRINT UCASE$(Path$): PRINT Mystr$πPass$ = "": p$ = "Please Enter Your Password =>"πMystr$ = Elvis$(p$, 32, 8, Pass$, 1)πPRINT : PRINT UCASE$(Pass$): PRINT Mystr$πIF Mystr$ <> "friend" THEN PRINT "Wrong Password": ELSE PRINT "OK"πFUNCTION Elvis$ (prompt$, max%, winsiz%, S$, sequins%)π Elvus prompt$, max%, winsiz%, S$, sequins%: Elvis$ = S$πEND FUNCTIONπSUB Elvus (prompt$, max%, winsiz%, S$, sequins%)π S$ = LTRIM$(RTRIM$(S$)): Cursor% = LEN(S$) - (Cursor% < max%)π F$ = "_": IF sequins% <> 0 THEN F$ = " "π Fill$ = STRING$(max%, F$)π S$ = LEFT$(S$ + Fill$, max%): INS% = -1: PRINT prompt$; " ";π Ybase% = POS(0)π WHILE done$ <> "DONE"π Sbase% = Cursor% - winsiz% + 1: IF Sbase% < 1 THEN Sbase% = 1π LOCATE , Ybase%, 0: Hid$ = STRING$(LEN(RTRIM$(S$)), "*")π IF sequins% = 0 THENπ PRINT MID$(S$ + Fill$, Sbase%, winsiz%); " ";π ELSEπ PRINT MID$(Hid$ + Fill$, Sbase%, winsiz%); " ";π END IFπ LOCATE , Ybase% + Cursor% - Sbase%, 1π k$ = "": WHILE k$ = "": k$ = INKEY$: WENDπ k% = ASC(k$): IF k% = 0 THEN k% = -ASC(MID$(k$, 2))π SELECT CASE k%π CASE 32 TO 127π IF INS% AND Cursor% < max% THENπ MID$(S$, Cursor% + 1) = MID$(S$, Cursor%)π S$ = LEFT$(S$, max%)π END IFπ MID$(S$, Cursor%, 1) = k$π IF Cursor% = max% THEN SOUND 999, 1π Cursor% = Cursor% - (Cursor% < max%)π CASE 13: IF S$ = Fill$ THEN S$ = ""π IF INSTR(S$, F$) > 0 THEN S$ = LEFT$(S$, INSTR(S$, F$) - 1)π EXIT SUBπ CASE 8π IF Cursor% > 1 THENπ Cursor% = Cursor% - 1π MID$(S$, Cursor%) = MID$(S$, Cursor% + 1)π MID$(S$, max%) = F$π ELSEπ SOUND 999, .7π END IFπ CASE 27: S$ = "": EXIT SUBπ CASE -71: Cursor% = 1π CASE -79: Cursor% = INSTR(S$, F$)π IF Cursor% = 0 THEN Cursor% = max%π CASE -82: INS% = -(INS% + 1): SOUND 1500 + 800 * INS%, .5π CASE -83π IF Cursor% < max% THENπ MID$(S$, Cursor%) = MID$(S$, Cursor% + 1)π MID$(S$, max%) = F$π ELSEπ SOUND 999, .7π END IFπ CASE -75: Cursor% = Cursor% - 1π lim% = INSTR(S$, F$): lim% = lim% - max% * (lim% = 0)π IF Cursor% < 1 THEN Cursor% = lim%π CASE -77: Cursor% = Cursor% + 1π lim% = INSTR(S$, F$): lim% = lim% - max% * (lim% = 0)π IF Cursor% > lim% THEN Cursor% = 1π END SELECTπ WENDπEND SUBπ'_|_|_| end ELVIS.BASπ 1 73 BRESENHAM LINE/CIRCLE ALGORITHMKurt Kuzba 2407 47 BASE CONVERSION ROUTINE Tyler Barnes 4184 133 PB HUFFMAN ENCODER M. Rosenberg 8975 17 NUMBER OF POSSIBLE COMBINATIONSFranklin Villamor 1 32 ENVIRONMENT PATHNAME Stuart McLachlan 1 116 DEBUG ASM CONVERTER Daniel Garlans 1 761 ENIGMA CODING PROGRAM Paul Kuliniewicz 26399 168 XOR ENCRYPTION/DECRYPTION Jonathan Leger 32768 44 8-BIT TO 6-BIT ENCODER/DECODER Kurt Kuzba 1 68 CHANGE FREQ OF SYSTEM TIMER Edward Di Geronimo Jr. 2445 64 LINEAR DATE Kevin J. Krumwiede 4380 225 CONTINUALLY DISPLAY ACTUAL TIMEEgbert Zijlema 11484 99 TRAP KEYBOARD INACTIVITY Egbert Zijlema 1 94 SPACE SHOWER DEMO Erik Bruggema 1 37 FIND AVAILABLE BYTES ON DRIVE Peter Norton 1 154 BATCH PROCEDURES Edward Blake 5065 56 FILE HANDLES Joe Negron 6919 76 READING FILES FROM DIRECTORY Ronald Kas 1 194 ETCH-A-SKETCH Steven Anthony Morisi 3549 48 WRITING PIXELS IN MODE 12H Kurt Kuzba 5695 259 GUI PROGRAMMER'S LIBRARY V1.23 Tika Carr 12493 179 QUICK MAZE MAKER Kris Reeves 23734 156 DRAW A CADIOID (DAISY) Don Schullian/Jim Oliver 1 15 GET BACK TO ROOT DIRECTORY Scott Turchin 627 816 FORMAT OF GRASP ANIMATION FILE George Phillips 1 382 MONOPOLY (LIKE THE BOARD GAME) Paul Kuliniewicz 25065 539 QBASIC PCMAN Akarsha Vasant Kumar 43181 338 QBASIC ROAD RACER Akarsha Vasant Kumar 52881 115 SOLO DOGFIGHTING David Zohorb 60486 809 LEAPGUY Steven Hanov 91088 375 HANG PERSON Steven Hanov 104360 112 PICK A NUMBER Steven Hanov 109932 414 TOAD HOP (FROGGER CLONE) The ABC Programmer 123754 142 AVOID BLUE MEANIES Kurt Kuzba 129550 753 PACMAN LIVES! Steven Hanov 150345 402 SUPER GALATIC WARS Robert Anthony Moreno 161069 1022 HEX-ALIGN 4X4 PUZZEL Jonathan Leger 190451 1430 WORLD CUP SOCCER '94 Alex Makris 251733 431 SPACE MAN FRED Ben Kington 260664 90 MATHEMATICAL WORMS OF XANTHE James McMurrin 266647 1068 FEDERATION DEFENDER Richard Hilsden 298122 1102 MINESWEEPER FOR DOS Akarsha Vasant Kumar 1 55 STAR TREK COMMUNICATOR PIN Andy J. Golden 1958 50 SCROLLING CELL MAP Steven Sensarn 5300 198 SCREEN ART/SAVER Scott Tuttle 12083 476 MODE-X MANDELBROT SET Erika Schulze 43149 204 FAST MEMCOPY ROUTINE Jonathan Leger 53509 86 GROWING FIRE Tony Lieuallen 55641 26 CHAOS Andy J. Golden 56345 26 FRACTAL FERN Andy J. Golden 57050 71 PUT W/O ERASING BACKGROUND Chad Beck 60235 72 HAPPY TRAILZ Kurt Kuzba 63235 86 ROTATING A BIG PALETTE SMOOTHLYKurt Kuzba 66643 184 320X240 MODEX WITH 3 PAGES Douglas Lusher 72452 114 PROG-DRAW 2.2 Ben Lloyd 79908 218 BURNING FIRE SIMULATOR Tony Cave 87108 77 BOUNCING GREAT BALLS OF FIRE Kurt Kuzba 90294 66 BUFFERED PCX VIEWER Kurt Kuzba 92959 59 DONUT BALLS Darryl Stokes 94234 86 PALETTE MANIPULATION Kurt Kuzba 98346 93 RAY CASTER 3D ENGINE Peter Cooper 101123 274 LED SCREEN SAVER Jonathan Leger 109817 486 ICON MAKER V1.0 Claude Gagné 121154 137 ANIMATION FACTORY V1.0 Gerald Filimonov 130029 519 RAY CASTER WITH KEYBOARD ISR Steven Sensarn 150053 519 HIGHSPEED RAYCASTING FOR PB Thomas Gohel 164337 59 BURNING TEXT Andrew L. Ayers 166118 39 STEEL PRINT Andrew L. Ayers 167266 120 PSYCHO PRINT Andrew L. Ayers 170808 88 FAST VGA SCROLL Andrew L. Ayers 173978 123 BIG TEXT SCROLL Andrew L. Ayers 177366 129 VGA PALETTE READ/WRITE ROUTINESAndrew L. Ayers 181064 175 VGA SINUSOIDAL PLASMA Andrew L. Ayers 185941 222 CLOUD PLASMA EFFECT Andrew L. Ayers 192111 93 BUFFER TO SCREEN COPY ROUTINE Andrew L. Ayers 196276 32 USING GET & PUT Kurt Kuzba 198244 935 GRAPHICS LOADER Jonathan Leger 223721 223 2D POLYGON ENGINE Brent P. Newhall 229316 197 VARIABLE PLASMA EFFECT Kurt Eckhardt 235448 243 TGA VIEWER Erika Schulze 245760 31 MATHEMATICAL FORMULA DISPLAYED James McMurrin 1 313 INTERRUPT TUTOR Tika Carr 13065 139 INTERRUPTS IN QBASIC Richard J. Backus 1 973 LIBERTY YAHTZEE Chris Sugden 1 770 PALETTE LIBRARY Joe Lawrence 1 357 USING EMS WITH MEMCOPY ROUTINE Jonathan Leger 12520 50 DIFFERENCE BETWEEN SADD/VARPTR Bob Perkins 14608 249 PB XMS ROUTINES Erika Schulze 1 274 OPEN UP TO 16 POPUP BOXES Charles Godard 8690 308 PB WINDOWS LIBRARY Bradley Miller 1 456 INTERNET SEARCH UTILITY Darryl Schneider 14946 125 PROGRAM THE PARALLEL PORT Christoph Kummetat 20019 245 BBS GAME PROGRAMMING Robert Fortune 28935 40 SET NEW PRINTER TIMEOUT VALUE Rick Pedley 1 239 ACCESSING COM PORT VIA INT 14 Robert Fortune 10294 77 REMOTE ACCESS UTILITIES Erik Bruggema 1 923 PB MOUSE IMPLEMENTATION Egbert Zijlema 1 77 SPLIT SCREEN COLOR ATTRIBUTE Egbert Zijlema 1 7 HAPPY BIRTHDAY SONG John Fischer 433 61 MORE THEME SONGS John Fischer 3664 39 FLUTE BOOK MUSIC COLLECTION Charles Godard 5845 319 PLAY MUSICAL HELPER John Fischer 16209 358 ADLIB SOUND EFFECTS Lloyd Chang 28351 158 PLAY ADLIB borg953@aol.com 33759 25 BOTTLES OF BEER ON THE WALL Tony Cave 34685 332 SOUND BLASTER PIANO Kurt Eckhardt 1 149 PERCENT BOX Charles Godard 4281 463 ENCODE/DECODE MESSAGE Darryl Schneider 16928 230 FAST PRINT REPLACEMENT Jonathan Leger 26368 82 LINE INPUT REPLACEMENT Kurt Kuzba